isomip/code_oad/ctrl_map_ini_genarr.F

2e7aec9951 dngo*0001 #include "CTRL_OPTIONS.h"
                0002 #define PREVENT_TOO_COLD_TEMP
                0003
                0004 CBOP
                0005 C     !ROUTINE: CTRL_MAP_INI_GENARR
                0006 C     !INTERFACE:
                0007       SUBROUTINE CTRL_MAP_INI_GENARR( myThid )
                0008
                0009 C     !DESCRIPTION: \bv
                0010 C     *=================================================================
                0011 C     | SUBROUTINE CTRL_MAP_INI_GENARR
                0012 C     | Add the generic arrays of the
                0013 C     | control vector to the model state and update the tile halos.
4d72283393 Mart*0014 C     | The control vector is defined in the header file "CTRL.h".
2e7aec9951 dngo*0015 C     *=================================================================
                0016 C     | local version for OpenAD exp. isomip
                0017 C     *=================================================================
                0018 C     \ev
                0019
                0020 C     !USES:
                0021       IMPLICIT NONE
                0022
                0023 C     == global variables ==
                0024 #include "SIZE.h"
                0025 #include "EEPARAMS.h"
                0026 #include "PARAMS.h"
                0027 #include "GRID.h"
                0028 #include "DYNVARS.h"
                0029 CML#include "FFIELDS.h"
                0030 #include "CTRL_SIZE.h"
4d72283393 Mart*0031 #include "CTRL.h"
2e7aec9951 dngo*0032 #include "CTRL_GENARR.h"
edcd27be69 Mart*0033 #include "CTRL_DUMMY.h"
65754df434 Mart*0034 #include "OPTIMCYCLE.h"
2e7aec9951 dngo*0035
                0036 C     !INPUT/OUTPUT PARAMETERS:
                0037 C     == routine arguments ==
                0038       INTEGER myThid
                0039
                0040 C     !FUNCTIONS:
                0041       INTEGER  ILNBLNk
                0042       EXTERNAL ILNBLNK
                0043
                0044 C     !LOCAL VARIABLES:
                0045 C     == local variables ==
                0046       INTEGER bi,bj
                0047       INTEGER i,j,k
                0048       INTEGER il
                0049       INTEGER iarr
                0050
                0051       LOGICAL doglobalread
                0052       LOGICAL ladinit
                0053       CHARACTER*(MAX_LEN_FNAM) fnamebase
de57a2ec4b Mart*0054       CHARACTER*(MAX_LEN_FNAM) fnamegeneric
2e7aec9951 dngo*0055       _RL     fac
                0056 #ifdef ALLOW_GENARR2D_CONTROL
                0057       _RL     tmpfld2d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,   nSx,nSy)
                0058 #endif
                0059 #ifdef ALLOW_GENARR3D_CONTROL
                0060       _RL     tmpfld3d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0061 #endif
                0062 CEOP
                0063
                0064       doglobalread = .FALSE.
                0065       ladinit      = .FALSE.
                0066       fac = 1. _d 0
                0067
                0068 #ifdef ALLOW_GENARR2D_CONTROL
                0069 C--   An example of connecting specific fields
                0070 C--   to 3 generic 2D control arrays
                0071 cc--->>>
                0072 cc--->>> COMPILE FAILURE IS DELIBERATE
                0073 cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
                0074 cc--->>>
                0075 C--   generic - user-defined control vars
                0076       DO iarr = 1, maxCtrlArr2D
                0077
                0078 C     These forcing control variables are constant in time for this
                0079 C     experiment, so that we can specify them here. Once we know how to
                0080 C     make OpenAD use the gentim2d controls, these should be handled via
                0081 C     ctrl_map_gentim2d.F
                0082        DO bj=myByLo(myThid), myByHi(myThid)
                0083         DO bi=myBxLo(myThid), myBxHi(myThid)
                0084          DO j = 1,sNy
                0085           DO i = 1,sNx
                0086            tmpfld2d(i,j,bi,bj) = 0. _d 0
                0087           ENDDO
                0088          ENDDO
                0089         ENDDO
                0090        ENDDO
                0091        fnamebase = xx_genarr2d_file(iarr)
                0092        il=ILNBLNK( fnamebase )
de57a2ec4b Mart*0093        WRITE(fnamegeneric,'(2A,I10.10)')
2e7aec9951 dngo*0094      &     fnamebase(1:il),'.',optimcycle
                0095        CALL ACTIVE_READ_XY ( fnamegeneric, tmpfld2d, 1,
                0096      &                      doglobalread, ladinit, optimcycle,
                0097      &                      myThid, xx_genarr2d_dummy(iarr) )
                0098        IF ( iarr .EQ. 1 ) THEN
                0099 CML        DO bj=myByLo(myThid), myByHi(myThid)
                0100 CML         DO bi=myBxLo(myThid), myBxHi(myThid)
                0101 CML          DO j = 1,sNy
                0102 CML           DO i = 1,sNx
                0103 CML            qnet(i,j,bi,bj) = qnet(i,j,bi,bj)
                0104 CML     &           + fac*tmpfld2d(i,j,bi,bj)
                0105 CML           ENDDO
                0106 CML          ENDDO
                0107 CML         ENDDO
                0108 CML        ENDDO
                0109        ELSEIF ( iarr .EQ. 2 ) THEN
                0110 CML        DO bj=myByLo(myThid), myByHi(myThid)
                0111 CML         DO bi=myBxLo(myThid), myBxHi(myThid)
                0112 CML          DO j = 1,sNy
                0113 CML           DO i = 1,sNx
                0114 CML            empmr(i,j,bi,bj) = empmr(i,j,bi,bj)
                0115 CML     &           + fac*tmpfld2d(i,j,bi,bj)
                0116 CML           ENDDO
                0117 CML          ENDDO
                0118 CML         ENDDO
                0119 CML        ENDDO
                0120        ELSEIF ( iarr .EQ. 3 ) THEN
                0121 CML        DO bj=myByLo(myThid), myByHi(myThid)
                0122 CML         DO bi=myBxLo(myThid), myBxHi(myThid)
                0123 CML          DO j = 1,sNy
                0124 CML           DO i = 1,sNx
                0125 CML            fu(i,j,bi,bj) = fu(i,j,bi,bj)
                0126 CML     &           + fac*tmpfld2d(i,j,bi,bj)
                0127 CML           ENDDO
                0128 CML          ENDDO
                0129 CML         ENDDO
                0130 CML        ENDDO
                0131        ELSEIF ( iarr .EQ. 4 ) THEN
                0132 CML        DO bj=myByLo(myThid), myByHi(myThid)
                0133 CML         DO bi=myBxLo(myThid), myBxHi(myThid)
                0134 CML          DO j = 1,sNy
                0135 CML           DO i = 1,sNx
                0136 CML            fv(i,j,bi,bj) = fv(i,j,bi,bj)
                0137 CML     &           + fac*tmpfld2d(i,j,bi,bj)
                0138 CML           ENDDO
                0139 CML          ENDDO
                0140 CML         ENDDO
                0141 CML        ENDDO
                0142        ENDIF
                0143 C--   end iarr loop
                0144       ENDDO
                0145 CML      _EXCH_XY_RS( qnet,  myThid )
                0146 CML      _EXCH_XY_RS( empmr, myThid )
                0147 CML      CALL EXCH_UV_XY_RS(fu,fv,.TRUE.,myThid)
                0148
                0149 #endif /* ALLOW_GENARR2D_CONTROL */
                0150
                0151 #ifdef ALLOW_GENARR3D_CONTROL
                0152 C--   An example of connecting specific fields
                0153 C--   to 3 generic 3D control arrays
                0154 cc--->>>
                0155 cc--->>> COMPILE FAILURE IS DELIBERATE
                0156 cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
                0157 cc--->>>
                0158 cc
                0159
                0160 C--   generic - user-defined control vars
                0161       DO iarr = 1, maxCtrlArr3D
                0162
                0163        DO bj=myByLo(myThid), myByHi(myThid)
                0164         DO bi=myBxLo(myThid), myBxHi(myThid)
                0165          DO k = 1,Nr
                0166           DO j = 1,sNy
                0167            DO i = 1,sNx
                0168             tmpfld3d(i,j,k,bi,bj) = 0. _d 0
                0169            ENDDO
                0170           ENDDO
                0171          ENDDO
                0172         ENDDO
                0173        ENDDO
                0174        fnamebase = xx_genarr3d_file(iarr)
                0175        il=ILNBLNK( fnamebase )
de57a2ec4b Mart*0176        WRITE(fnamegeneric,'(2A,I10.10)')
2e7aec9951 dngo*0177      &     fnamebase(1:il),'.',optimcycle
                0178        CALL ACTIVE_READ_XYZ( fnamegeneric, tmpfld3d, 1,
                0179      &                       doglobalread, ladinit, optimcycle,
                0180      &                       myThid, xx_genarr3d_dummy(iarr) )
                0181        IF ( iarr .EQ. 1 ) THEN
                0182         DO bj=myByLo(myThid), myByHi(myThid)
                0183          DO bi=myBxLo(myThid), myBxHi(myThid)
                0184           DO k = 1,Nr
                0185            DO j = 1,sNy
                0186             DO i = 1,sNx
                0187              theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
                0188      &         + fac*tmpfld3d(i,j,k,bi,bj)
                0189 #ifdef PREVENT_TOO_COLD_TEMP
                0190 C     necessary to reproduce old results
                0191              IF ( theta(i,j,k,bi,bj).LT.-2.0 _d 0 )
                0192      &            theta(i,j,k,bi,bj) = -2.0 _d 0
                0193 #endif
                0194             ENDDO
                0195            ENDDO
                0196           ENDDO
                0197          ENDDO
                0198         ENDDO
                0199         CALL EXCH_3D_RL( theta, Nr, myThid )
                0200        ELSEIF ( iarr .EQ. 2 ) THEN
                0201         DO bj=myByLo(myThid), myByHi(myThid)
                0202          DO bi=myBxLo(myThid), myBxHi(myThid)
                0203           DO k = 1,Nr
                0204            DO j = 1,sNy
                0205             DO i = 1,sNx
                0206              salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
                0207      &         + fac*tmpfld3d(i,j,k,bi,bj)
                0208             ENDDO
                0209            ENDDO
                0210           ENDDO
                0211          ENDDO
                0212         ENDDO
                0213         CALL EXCH_3D_RL( salt, Nr, myThid )
                0214        ELSEIF ( iarr .EQ. 3 ) THEN
                0215         DO bj=myByLo(myThid), myByHi(myThid)
                0216          DO bi=myBxLo(myThid), myBxHi(myThid)
                0217           DO k = 1,Nr
                0218            DO j = 1,sNy
                0219             DO i = 1,sNx
                0220              diffKr(i,j,k,bi,bj) = diffKr(i,j,k,bi,bj)
                0221      &         + fac*tmpfld3d(i,j,k,bi,bj)
                0222             ENDDO
                0223            ENDDO
                0224           ENDDO
                0225          ENDDO
                0226         ENDDO
                0227         CALL EXCH_3D_RL( diffKr, Nr, myThid )
                0228        ENDIF
                0229
                0230 C--   end iarr loop
                0231       ENDDO
                0232
                0233 #endif /* ALLOW_GENARR3D_CONTROL */
                0234
                0235       RETURN
                0236       END