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