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