C $Header: /u/gcmpack/MITgcm/pkg/profiles/active_file_control_profiles.F,v 1.9 2015/08/06 15:48:20 gforget Exp $
C $Name: $
#include "PROFILES_OPTIONS.h"
C o==========================================================o
C | subroutine active_file_control_profile |
C | o handles the i/o of active variables for the adjoint |
C | calculations, related to netcdf profiles data files |
C | o active_read_profile_rl, active_write_profile_rl |
C | started: Gael Forget 15-March-2006 |
C o==========================================================o
subroutine ACTIVE_READ_PROFILE_RL(
I fid,
I active_num_file,
I nactive_var,
O active_var,
I active_varnum,
I lAdInit,
I irec,
I irecglob,
I theSimulationMode,
I myOptimIter,
I bi,
I bj,
I mythid
& )
c ==================================================================
c
c o Read an active 1D record.
c
c ==================================================================
implicit none
c == global variables ==
#include "EEPARAMS.h"
#include "SIZE.h"
#include "PARAMS.h"
#ifdef ALLOW_PROFILES
# include "netcdf.inc"
# include "PROFILES_SIZE.h"
# include "profiles.h"
#endif
c == routine arguments ==
integer err, fid, varid1 , vec_start(2), vec_count(2)
logical lAdInit
integer irec, irecglob,active_varnum
integer theSimulationMode
integer myOptimIter
integer bi,bj,mythid
integer nactive_var,active_num_file
_RL active_var(nactive_var)
_RL active_data_t(nactive_var)
integer i,ivar
real*8 vec_tmp(nactive_var+1)
#ifdef ALLOW_PROFILES
c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
c >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
if (theSimulationMode .eq. FORWARD_SIMULATION) then
_BEGIN_MASTER( mythid )
if (profilesDoNcOutput) then
vec_start(1)=1
vec_start(2)=irec
vec_count(1)=nactive_var
vec_count(2)=1
err = NF_INQ_VARID(fid,prof_names(active_num_file,active_varnum),
& varid1 )
err = NF_GET_VARA_DOUBLE(fid, varid1 , vec_start, vec_count,
& active_var)
err = NF_INQ_VARID(fid,prof_namesmask(active_num_file,
& active_varnum), varid1)
err = NF_GET_VARA_DOUBLE(fid, varid1 , vec_start, vec_count,
& prof_mask1D_cur(1,bi,bj))
else
read(fid,rec=( (irec-1)*prof_num_var_tot(active_num_file,bi,bj)
& +prof_num_var_cur(active_num_file,active_varnum,bi,bj)-1)*2+1 )
& vec_tmp
#ifdef _BYTESWAPIO
call MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
#endif
do ivar=1,nactive_var
active_var(ivar)=vec_tmp(ivar)
enddo
read(fid,rec=( (irec-1)*prof_num_var_tot(active_num_file,bi,bj)
& +prof_num_var_cur(active_num_file,active_varnum,bi,bj)-1)*2+2 )
& vec_tmp
#ifdef _BYTESWAPIO
call MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
#endif
do ivar=1,nactive_var
prof_mask1D_cur(ivar,bi,bj)=vec_tmp(ivar)
enddo
endif
_END_MASTER( mythid )
endif
c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
if (theSimulationMode .eq. REVERSE_SIMULATION) then
_BEGIN_MASTER( mythid )
if (profilesDoNcOutput) then
vec_start(1)=1
vec_start(2)=irec
vec_count(1)=nactive_var
vec_count(2)=1
err = NF_INQ_VARID(fid,prof_names(active_num_file,active_varnum),
& varid1 )
err = NF_GET_VARA_DOUBLE(fid, varid1 , vec_start, vec_count,
& active_data_t)
c Add active_var from appropriate location to data.
do i = 1,nactive_var
active_data_t(i) = active_data_t(i) + active_var(i)
enddo
c Store the result on disk.
vec_start(1)=1
vec_start(2)=irec
vec_count(1)=nactive_var
vec_count(2)=1
err = NF_INQ_VARID(fid,prof_names(active_num_file,active_varnum),
& varid1 )
err = NF_PUT_VARA_DOUBLE(fid, varid1 , vec_start, vec_count,
& active_data_t)
c Set active_var to zero.
do i = 1,nactive_var
active_var(i) = 0. _d 0
enddo
else
read(fid,rec=( (irec-1)*prof_num_var_tot(active_num_file,bi,bj)
& +prof_num_var_cur(active_num_file,active_varnum,bi,bj)-1)*2+1 )
& vec_tmp
#ifdef _BYTESWAPIO
call MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
#endif
do ivar=1,nactive_var
active_data_t(ivar)=vec_tmp(ivar)
enddo
c Add active_var from appropriate location to data.
do i = 1,nactive_var
active_data_t(i) = active_data_t(i) + active_var(i)
enddo
c Store the result on disk.
do ivar=1,nactive_var
vec_tmp(ivar)=active_data_t(ivar)
enddo
#ifdef _BYTESWAPIO
call MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
#endif
write(fid,rec=( (irec-1)*prof_num_var_tot(active_num_file,bi,bj)
& +prof_num_var_cur(active_num_file,active_varnum,bi,bj)-1)*2+1 )
& vec_tmp
c Set active_var to zero.
do i = 1,nactive_var
active_var(i) = 0. _d 0
enddo
endif
_END_MASTER( mythid )
endif
c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
c >>>>>>>>>>>>>>>>>>> TANGENT RUN <<<<<<<<<<<<<<<<<<<
c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
if (theSimulationMode .eq. TANGENT_SIMULATION) then
_BEGIN_MASTER( mythid )
if (profilesDoNcOutput) then
vec_start(1)=1
vec_start(2)=irec
vec_count(1)=nactive_var
vec_count(2)=1
err = NF_INQ_VARID(fid,prof_names(active_num_file,active_varnum),
& varid1 )
err = NF_GET_VARA_DOUBLE(fid, varid1 , vec_start, vec_count,
& active_var)
else
read(fid,rec=( (irec-1)*prof_num_var_tot(active_num_file,bi,bj)
& +prof_num_var_cur(active_num_file,active_varnum,bi,bj)-1)*2+1 )
& vec_tmp
#ifdef _BYTESWAPIO
call MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
#endif
do ivar=1,nactive_var
active_var(ivar)=vec_tmp(ivar)
enddo
endif
_END_MASTER( mythid )
endif
#endif /* ALLOW_PROFILES */
return
end
c ==================================================================
subroutine ACTIVE_WRITE_PROFILE_RL(
I fid,
I active_num_file,
I nactive_var,
I active_var,
I active_varnum,
I irec,
I irecglob,
I theSimulationMode,
I myOptimIter,
I bi,
I bj,
I mythid
& )
c ==================================================================
c
c o Write an active 1D record to a file.
c
c ==================================================================
implicit none
c == global variables ==
#include "EEPARAMS.h"
#include "SIZE.h"
#include "PARAMS.h"
#ifdef ALLOW_PROFILES
# include "netcdf.inc"
# include "PROFILES_SIZE.h"
# include "profiles.h"
#endif
c == routine arguments ==
integer err, fid, varid1 , vec_start(2), vec_count(2)
integer ivar, irec, irecglob,active_varnum
integer theSimulationMode
integer myOptimIter
integer bi,bj,mythid
integer nactive_var,active_num_file
_RL active_var(nactive_var)
real*8 vec_tmp(nactive_var+1)
#ifdef ALLOW_PROFILES
c == local variables ==
integer i
_RL active_data_t(nactive_var)
c == end of interface ==
c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
c >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
if (theSimulationMode .eq. FORWARD_SIMULATION) then
_BEGIN_MASTER( mythid )
if (profilesDoNcOutput) then
vec_start(1)=1
vec_start(2)=irec
vec_count(1)=nactive_var
vec_count(2)=1
err = NF_INQ_VARID(fid,prof_names(active_num_file,active_varnum),
& varid1 )
err = NF_PUT_VARA_DOUBLE(fid, varid1 , vec_start, vec_count,
& active_var)
err = NF_INQ_VARID(fid,prof_namesmask(active_num_file,
& active_varnum), varid1 )
err = NF_PUT_VARA_DOUBLE(fid, varid1 , vec_start, vec_count,
& prof_mask1D_cur(1,bi,bj))
err = NF_INQ_VARID(fid,'prof_ind_glob', varid1 )
err = NF_PUT_VAR1_INT(fid, varid1 , vec_start(2),
& irecglob)
else
do ivar=1,nactive_var
vec_tmp(ivar)=active_var(ivar)
enddo
vec_tmp(nactive_var+1)=irecglob
#ifdef _BYTESWAPIO
call MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
#endif
write(fid,rec=( (irec-1)*prof_num_var_tot(active_num_file,bi,bj)
& +prof_num_var_cur(active_num_file,active_varnum,bi,bj)-1)*2+1 )
& vec_tmp
do ivar=1,nactive_var
vec_tmp(ivar)=prof_mask1D_cur(ivar,bi,bj)
enddo
vec_tmp(nactive_var+1)=irecglob
#ifdef _BYTESWAPIO
call MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
#endif
write(fid,rec=( (irec-1)*prof_num_var_tot(active_num_file,bi,bj)
& +prof_num_var_cur(active_num_file,active_varnum,bi,bj)-1)*2+2 )
& vec_tmp
endif
_END_MASTER( mythid )
endif
c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
if (theSimulationMode .eq. REVERSE_SIMULATION) then
_BEGIN_MASTER( mythid )
if (profilesDoNcOutput) then
vec_start(1)=1
vec_start(2)=irec
vec_count(1)=nactive_var
vec_count(2)=1
err = NF_INQ_VARID(fid,prof_names(active_num_file,active_varnum),
& varid1 )
err = NF_GET_VARA_DOUBLE(fid, varid1 , vec_start, vec_count,
& active_data_t)
c Add active_var to data.
do i = 1,nactive_var
active_var(i) = active_var(i) + active_data_t(i)
active_data_t(i) = 0. _d 0
enddo
vec_start(1)=1
vec_start(2)=irec
vec_count(1)=nactive_var
vec_count(2)=1
err = NF_INQ_VARID(fid,prof_names(active_num_file,active_varnum),
& varid1 )
err = NF_PUT_VARA_DOUBLE(fid, varid1 , vec_start, vec_count,
& active_data_t)
else
read(fid,rec=( (irec-1)*prof_num_var_tot(active_num_file,bi,bj)
& +prof_num_var_cur(active_num_file,active_varnum,bi,bj)-1)*2+1 )
& vec_tmp
#ifdef _BYTESWAPIO
call MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
#endif
do ivar=1,nactive_var
active_data_t(ivar)=vec_tmp(ivar)
enddo
c Add active_var from appropriate location to data.
do i = 1,nactive_var
active_var(i) = active_var(i) + active_data_t(i)
active_data_t(i) = 0. _d 0
enddo
c Store the result on disk.
do ivar=1,nactive_var
vec_tmp(ivar)=active_data_t(ivar)
enddo
#ifdef _BYTESWAPIO
call MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
#endif
write(fid,rec=( (irec-1)*prof_num_var_tot(active_num_file,bi,bj)
& +prof_num_var_cur(active_num_file,active_varnum,bi,bj)-1)*2+1 )
& vec_tmp
endif
_END_MASTER( mythid )
endif
c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
c >>>>>>>>>>>>>>>>>>> TANGENT RUN <<<<<<<<<<<<<<<<<<<
c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
if (theSimulationMode .eq. TANGENT_SIMULATION) then
_BEGIN_MASTER( mythid )
if (profilesDoNcOutput) then
vec_start(1)=1
vec_start(2)=irec
vec_count(1)=nactive_var
vec_count(2)=1
err = NF_INQ_VARID(fid, prof_names(active_num_file,active_varnum),
& varid1 )
err = NF_PUT_VARA_DOUBLE(fid, varid1 , vec_start, vec_count,
& active_var)
else
do ivar=1,nactive_var
vec_tmp(ivar)=active_var(ivar)
enddo
vec_tmp(nactive_var+1)=irecglob
#ifdef _BYTESWAPIO
call MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
#endif
write(fid,rec=( (irec-1)*prof_num_var_tot(active_num_file,bi,bj)
& +prof_num_var_cur(active_num_file,active_varnum,bi,bj)-1)*2+1 )
& vec_tmp
endif
_END_MASTER( mythid )
endif
#endif /* ALLOW_PROFILES */
return
end