C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_forcing.F,v 1.20 2017/01/20 20:51:35 gforget Exp $ C $Name: $ #include "CTRL_OPTIONS.h" CBOP C !ROUTINE: CTRL_MAP_FORCING C !INTERFACE: SUBROUTINE CTRL_MAP_FORCING( myTime, myIter, myThid ) C !DESCRIPTION: \bv c *================================================================= c | SUBROUTINE CTRL_MAP_FORCING c | Add the surface flux anomalies of the control vector c | to the model flux fields and update the tile halos. c | The control vector is defined in the header file "ctrl.h". c *================================================================= C \ev C !USES: IMPLICIT NONE C == Global variables === #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "FFIELDS.h" #include "DYNVARS.h" #include "GRID.h" #include "CTRL_SIZE.h" #include "ctrl.h" #include "CTRL_GENARR.h" #include "ctrl_dummy.h" #include "optim.h" #ifdef ALLOW_AUTODIFF #include "AUTODIFF_MYFIELDS.h" #endif C !INPUT/OUTPUT PARAMETERS: C == Routine arguments == C myTime :: time counter for this thread C myIter :: iteration counter for this thread C myThid :: thread number for this instance of the routine. _RL myTime INTEGER myIter INTEGER myThid C !LOCAL VARIABLES: C == Local variables == integer bi,bj integer i,j integer itlo,ithi integer jtlo,jthi integer jmin,jmax integer imin,imax #ifndef ALLOW_OPENAD #ifdef ALLOW_GENTIM2D_CONTROL integer iarr _RL tmpUE(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) _RL tmpVN(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) _RL tmpUX(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) _RL tmpVY(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) #endif #endif #if (defined ALLOW_TAUU0_CONTROL) (defined ALLOW_TAUV0_CONTROL) (defined ALLOW_SFLUX0_CONTROL) (defined ALLOW_HFLUX0_CONTROL) (defined ALLOW_SSS_CONTROL) (defined ALLOW_SST_CONTROL) (defined ALLOW_HFLUXM_CONTROL) integer il logical doglobalread logical ladinit character*( 80) fnametauu character*( 80) fnametauv character*( 80) fnamesflux character*( 80) fnamehflux character*( 80) fnamesss character*( 80) fnamesst cHFLUXM_CONTROL character*( 80) fnamehfluxm cHFLUXM_CONTROL c == external == integer ilnblnk external #endif c == end of interface == CEOP jtlo = mybylo(mythid) jthi = mybyhi(mythid) itlo = mybxlo(mythid) ithi = mybxhi(mythid) jmin = 1 jmax = sny imin = 1 imax = snx #if (defined ALLOW_TAUU0_CONTROL) (defined ALLOW_TAUV0_CONTROL) (defined ALLOW_SFLUX0_CONTROL) (defined ALLOW_HFLUX0_CONTROL) (defined ALLOW_SSS_CONTROL) (defined ALLOW_SST_CONTROL) (defined ALLOW_HFLUXM_CONTROL) doglobalread = .false. ladinit = .false. IF ( myIter .EQ. nIter0 ) THEN #ifdef ALLOW_TAUU0_CONTROL c-- tauu0. il=ilnblnk( xx_tauu_file ) write(fnametauu(1:80),'(2a,i10.10)') & xx_tauu_file(1:il),'.',optimcycle call ACTIVE_READ_XY ( fnametauu, tmpfld2d, 1, & doglobalread, ladinit, optimcycle, & mythid, xx_tauu_dummy ) do bj = jtlo,jthi do bi = itlo,ithi do j = jmin,jmax do i = imin,imax # ifdef ALLOW_OPENAD fu(i,j,bi,bj) = fu(i,j,bi,bj) + & xx_tauu0(i,j,bi,bj) + & tmpfld2d(i,j,bi,bj) #else fu(i,j,bi,bj) = fu(i,j,bi,bj) + tmpfld2d(i,j,bi,bj) #endif enddo enddo enddo enddo #endif #ifdef ALLOW_TAUV0_CONTROL c-- tauv0. il=ilnblnk( xx_tauv_file ) write(fnametauv(1:80),'(2a,i10.10)') & xx_tauv_file(1:il),'.',optimcycle call ACTIVE_READ_XY ( fnametauv, tmpfld2d, 1, & doglobalread, ladinit, optimcycle, & mythid, xx_tauv_dummy ) do bj = jtlo,jthi do bi = itlo,ithi do j = jmin,jmax do i = imin,imax # ifdef ALLOW_OPENAD fv(i,j,bi,bj) = fv(i,j,bi,bj) + & xx_tauv0(i,j,bi,bj) + & tmpfld2d(i,j,bi,bj) #else fv(i,j,bi,bj) = fv(i,j,bi,bj) + tmpfld2d(i,j,bi,bj) #endif enddo enddo enddo enddo #endif #ifdef ALLOW_SFLUX0_CONTROL c-- sflux0. il=ilnblnk( xx_sflux_file ) write(fnamesflux(1:80),'(2a,i10.10)') & xx_sflux_file(1:il),'.',optimcycle call ACTIVE_READ_XY ( fnamesflux, tmpfld2d, 1, & doglobalread, ladinit, optimcycle, & mythid, xx_sflux_dummy ) do bj = jtlo,jthi do bi = itlo,ithi do j = jmin,jmax do i = imin,imax # ifdef ALLOW_OPENAD empmr(i,j,bi,bj) = empmr(i,j,bi,bj) + & xx_sflux0(i,j,bi,bj) + & tmpfld2d(i,j,bi,bj) #else empmr(i,j,bi,bj) = empmr(i,j,bi,bj) + tmpfld2d(i,j,bi,bj) #endif enddo enddo enddo enddo #endif #ifdef ALLOW_HFLUX0_CONTROL c-- hflux0. il=ilnblnk( xx_hflux_file ) write(fnamehflux(1:80),'(2a,i10.10)') & xx_hflux_file(1:il),'.',optimcycle call ACTIVE_READ_XY ( fnamehflux, tmpfld2d, 1, & doglobalread, ladinit, optimcycle, & mythid, xx_hflux_dummy ) do bj = jtlo,jthi do bi = itlo,ithi do j = jmin,jmax do i = imin,imax # ifdef ALLOW_OPENAD qnet(i,j,bi,bj) = qnet(i,j,bi,bj) + & xx_hflux0(i,j,bi,bj) + & tmpfld2d(i,j,bi,bj) #else qnet(i,j,bi,bj) = qnet(i,j,bi,bj) + tmpfld2d(i,j,bi,bj) #endif enddo enddo enddo enddo #endif #ifdef ALLOW_SSS_CONTROL c-- sss0. il=ilnblnk( xx_sss_file ) write(fnamesss(1:80),'(2a,i10.10)') & xx_sss_file(1:il),'.',optimcycle call ACTIVE_READ_XY ( fnamesss, tmpfld2d, 1, & doglobalread, ladinit, optimcycle, & mythid, xx_sss_dummy ) do bj = jtlo,jthi do bi = itlo,ithi do j = jmin,jmax do i = imin,imax sss(i,j,bi,bj) = sss(i,j,bi,bj) + tmpfld2d(i,j,bi,bj) enddo enddo enddo enddo #endif #ifdef ALLOW_SST_CONTROL c-- sst0. il=ilnblnk( xx_sst_file ) write(fnamesst(1:80),'(2a,i10.10)') & xx_sst_file(1:il),'.',optimcycle call ACTIVE_READ_XY ( fnamesst, tmpfld2d, 1, & doglobalread, ladinit, optimcycle, & mythid, xx_sst_dummy ) do bj = jtlo,jthi do bi = itlo,ithi do j = jmin,jmax do i = imin,imax sst(i,j,bi,bj) = sst(i,j,bi,bj) + tmpfld2d(i,j,bi,bj) enddo enddo enddo enddo #endif #ifdef ALLOW_HFLUXM_CONTROL c-- hfluxm. il=ilnblnk( xx_hfluxm_file ) write(fnamehfluxm(1:80),'(2a,i10.10)') & xx_hfluxm_file(1:il),'.',optimcycle call ACTIVE_READ_XY ( fnamehfluxm, tmpfld2d, 1, & doglobalread, ladinit, optimcycle, & mythid, xx_hfluxm_dummy ) do bj = jtlo,jthi do bi = itlo,ithi do j = jmin,jmax do i = imin,imax # ifdef ALLOW_OPENAD Qnetm(i,j,bi,bj) = Qnetm(i,j,bi,bj) + & xx_hfluxm(i,j,bi,bj) + & tmpfld2d(i,j,bi,bj) #else Qnetm(i,j,bi,bj) = Qnetm(i,j,bi,bj) + tmpfld2d(i,j,bi,bj) #endif enddo enddo enddo enddo #endif #if (defined (ALLOW_TAUU0_CONTROL) defined (ALLOW_TAUV0_CONTROL)) CALL EXCH_UV_XY_RS(fu,fv,.TRUE.,myThid) #endif #ifdef ALLOW_SFLUX0_CONTROL _EXCH_XY_RS(EmPmR, myThid ) #endif #ifdef ALLOW_HFLUX0_CONTROL _EXCH_XY_RS(Qnet, myThid ) #endif #ifdef ALLOW_SST_CONTROL _EXCH_XY_RS(SST, myThid ) #endif #ifdef ALLOW_SSS_CONTROL _EXCH_XY_RS(SSS, myThid ) #endif #ifdef ALLOW_HFLUXM_CONTROL _EXCH_XY_RS(Qnetm, myThid ) #endif ENDIF !IF ( myIter .EQ. nIter0 ) THEN #endif #ifndef ALLOW_OPENAD #ifdef ALLOW_GENTIM2D_CONTROL IF ( ctrlUseGen ) THEN do bj = mybylo(mythid),mybyhi(mythid) do bi = mybxlo(mythid),mybxhi(mythid) do j = 1-oly,sny+oly do i = 1-olx,snx+olx tmpUE(i,j,bi,bj) = 0. _d 0 tmpVN(i,j,bi,bj) = 0. _d 0 tmpUX(i,j,bi,bj) = 0. _d 0 tmpVY(i,j,bi,bj) = 0. _d 0 enddo enddo enddo enddo DO bj = myByLo(myThid),myByHi(myThid) DO bi = myBxLo(myThid),mybxhi(myThid) DO j = 1,sNy DO i = 1,sNx DO iarr = 1, maxCtrlTim2D if (xx_gentim2d_file(iarr)(1:5).EQ.'xx_fe') tmpUE & (i,j,bi,bj)=tmpUE(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr) if (xx_gentim2d_file(iarr)(1:5).EQ.'xx_fn') tmpVN & (i,j,bi,bj)=tmpVN(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr) ENDDO ENDDO ENDDO ENDDO ENDDO _EXCH_XY_RL(tmpUE,myThid) _EXCH_XY_RL(tmpVN,myThid) CALL ROTATE_UV2EN_RL(tmpUX,tmpVY,tmpUE,tmpVN, & .FALSE.,.TRUE.,.TRUE.,1,mythid) DO bj = myByLo(myThid),myByHi(myThid) DO bi = myBxLo(myThid),mybxhi(myThid) DO j = 1,sny DO i = 1,snx fu(i,j,bi,bj)=fu(i,j,bi,bj)+tmpUX(i,j,bi,bj) fv(i,j,bi,bj)=fv(i,j,bi,bj)+tmpVY(i,j,bi,bj) DO iarr = 1, maxCtrlTim2D if (xx_gentim2d_file(iarr)(1:7).EQ.'xx_qnet') Qnet & (i,j,bi,bj)=Qnet(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr) if (xx_gentim2d_file(iarr)(1:8).EQ.'xx_empmr') EmPmR & (i,j,bi,bj)=EmPmR(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr) if (xx_gentim2d_file(iarr)(1:6).EQ.'xx_qsw') Qsw & (i,j,bi,bj)=Qsw(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr) if (xx_gentim2d_file(iarr)(1:6).EQ.'xx_sst') SST & (i,j,bi,bj)=SST(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr) if (xx_gentim2d_file(iarr)(1:6).EQ.'xx_sss') SSS & (i,j,bi,bj)=SSS(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr) if (xx_gentim2d_file(iarr)(1:8).EQ.'xx_pload') pLoad & (i,j,bi,bj)=pLoad(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr) if (xx_gentim2d_file(iarr)(1:11).EQ.'xx_saltflux') saltFlux & (i,j,bi,bj)=saltFlux(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr) if (xx_gentim2d_file(iarr)(1:5).EQ.'xx_fu') fu & (i,j,bi,bj)=fu(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr) if (xx_gentim2d_file(iarr)(1:5).EQ.'xx_fv') fv & (i,j,bi,bj)=fv(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr) ENDDO ENDDO ENDDO ENDDO ENDDO CALL EXCH_XY_RS( Qnet , myThid ) CALL EXCH_XY_RS( EmPmR , myThid ) CALL EXCH_XY_RS( Qsw , myThid ) CALL EXCH_XY_RS( SST , myThid ) CALL EXCH_XY_RS( SSS , myThid ) CALL EXCH_XY_RS( pLoad , myThid ) CALL EXCH_XY_RS( saltFlux , myThid ) CALL EXCH_UV_XY_RS( fu, fv, .TRUE., myThid ) ENDIF !IF (ctrlUseGen) then #endif #endif RETURN END