global_ocean.90x40x15/code_oad/ctrl_map_ini_genarr.F

2e7aec9951 dngo*0001 #include "CTRL_OPTIONS.h"
                0002 #undef 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. OpenAD, global_ocean.90x40x15
                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 #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 #ifdef ALLOW_PTRACERS
                0036 # include "PTRACERS_SIZE.h"
                0037 c#include "PTRACERS_PARAMS.h"
                0038 # include "PTRACERS_FIELDS.h"
                0039 #endif
                0040
                0041 C     !INPUT/OUTPUT PARAMETERS:
                0042 C     == routine arguments ==
                0043       INTEGER myThid
                0044
                0045 C     !FUNCTIONS:
                0046       INTEGER  ILNBLNk
                0047       EXTERNAL ILNBLNK
                0048
                0049 C     !LOCAL VARIABLES:
                0050 C     == local variables ==
                0051       INTEGER bi,bj
                0052       INTEGER i,j,k
                0053       INTEGER il
                0054       INTEGER iarr
                0055
                0056       LOGICAL doglobalread
                0057       LOGICAL ladinit
                0058       CHARACTER*(MAX_LEN_FNAM) fnamebase
de57a2ec4b Mart*0059       CHARACTER*(MAX_LEN_FNAM) fnamegeneric
2e7aec9951 dngo*0060       _RL     fac
                0061 #ifdef ALLOW_GENARR2D_CONTROL
                0062       _RL     tmpfld2d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,   nSx,nSy)
                0063 #endif
                0064 #ifdef ALLOW_GENARR3D_CONTROL
                0065       _RL     tmpfld3d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0066 #endif
                0067 CEOP
                0068
                0069       doglobalread = .FALSE.
                0070       ladinit      = .FALSE.
                0071       fac = 1. _d 0
                0072
                0073 #ifdef ALLOW_GENARR2D_CONTROL
                0074 C--   An example of connecting specific fields
                0075 C--   to 3 generic 2D control arrays
                0076 cc--->>>
                0077 cc--->>> COMPILE FAILURE IS DELIBERATE
                0078 cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
                0079 cc--->>>
                0080 C--   generic - user-defined control vars
                0081       DO iarr = 1, maxCtrlArr2D
                0082
                0083 C     These forcing control variables are constant in time for this
                0084 C     experiment, so that we can specify them here. Once we know how to
                0085 C     make OpenAD use the gentim2d controls, these should be handled via
                0086 C     ctrl_map_gentim2d.F
                0087        DO bj=myByLo(myThid), myByHi(myThid)
                0088         DO bi=myBxLo(myThid), myBxHi(myThid)
                0089          DO j = 1,sNy
                0090           DO i = 1,sNx
                0091            tmpfld2d(i,j,bi,bj) = 0. _d 0
                0092           ENDDO
                0093          ENDDO
                0094         ENDDO
                0095        ENDDO
                0096        fnamebase = xx_genarr2d_file(iarr)
                0097        il=ILNBLNK( fnamebase )
de57a2ec4b Mart*0098        WRITE(fnamegeneric,'(2A,I10.10)')
2e7aec9951 dngo*0099      &     fnamebase(1:il),'.',optimcycle
                0100        CALL ACTIVE_READ_XY ( fnamegeneric, tmpfld2d, 1,
                0101      &                      doglobalread, ladinit, optimcycle,
                0102      &                      myThid, xx_genarr2d_dummy(iarr) )
                0103        IF ( iarr .EQ. 1 ) THEN
                0104         DO bj=myByLo(myThid), myByHi(myThid)
                0105          DO bi=myBxLo(myThid), myBxHi(myThid)
                0106           DO j = 1,sNy
                0107            DO i = 1,sNx
                0108             qnet(i,j,bi,bj) = qnet(i,j,bi,bj)
                0109      &           + fac*tmpfld2d(i,j,bi,bj)
                0110            ENDDO
                0111           ENDDO
                0112          ENDDO
                0113         ENDDO
                0114        ELSEIF ( iarr .EQ. 2 ) THEN
                0115         DO bj=myByLo(myThid), myByHi(myThid)
                0116          DO bi=myBxLo(myThid), myBxHi(myThid)
                0117           DO j = 1,sNy
                0118            DO i = 1,sNx
                0119             empmr(i,j,bi,bj) = empmr(i,j,bi,bj)
                0120      &           + fac*tmpfld2d(i,j,bi,bj)
                0121            ENDDO
                0122           ENDDO
                0123          ENDDO
                0124         ENDDO
                0125        ELSEIF ( iarr .EQ. 3 ) THEN
                0126         DO bj=myByLo(myThid), myByHi(myThid)
                0127          DO bi=myBxLo(myThid), myBxHi(myThid)
                0128           DO j = 1,sNy
                0129            DO i = 1,sNx
                0130             fu(i,j,bi,bj) = fu(i,j,bi,bj)
                0131      &           + fac*tmpfld2d(i,j,bi,bj)
                0132            ENDDO
                0133           ENDDO
                0134          ENDDO
                0135         ENDDO
                0136        ELSEIF ( iarr .EQ. 4 ) THEN
                0137         DO bj=myByLo(myThid), myByHi(myThid)
                0138          DO bi=myBxLo(myThid), myBxHi(myThid)
                0139           DO j = 1,sNy
                0140            DO i = 1,sNx
                0141             fv(i,j,bi,bj) = fv(i,j,bi,bj)
                0142      &           + fac*tmpfld2d(i,j,bi,bj)
                0143            ENDDO
                0144           ENDDO
                0145          ENDDO
                0146         ENDDO
                0147        ENDIF
                0148 C--   end iarr loop
                0149       ENDDO
                0150       _EXCH_XY_RS( qnet,  myThid )
                0151       _EXCH_XY_RS( empmr, myThid )
                0152       CALL EXCH_UV_XY_RS(fu,fv,.TRUE.,myThid)
                0153
                0154 #endif /* ALLOW_GENARR2D_CONTROL */
                0155
                0156 #ifdef ALLOW_GENARR3D_CONTROL
                0157 C--   An example of connecting specific fields
                0158 C--   to 3 generic 3D control arrays
                0159 cc--->>>
                0160 cc--->>> COMPILE FAILURE IS DELIBERATE
                0161 cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
                0162 cc--->>>
                0163 cc
                0164
                0165 C--   generic - user-defined control vars
                0166       DO iarr = 1, maxCtrlArr3D
                0167
                0168        DO bj=myByLo(myThid), myByHi(myThid)
                0169         DO bi=myBxLo(myThid), myBxHi(myThid)
                0170          DO k = 1,Nr
                0171           DO j = 1,sNy
                0172            DO i = 1,sNx
                0173             tmpfld3d(i,j,k,bi,bj) = 0. _d 0
                0174            ENDDO
                0175           ENDDO
                0176          ENDDO
                0177         ENDDO
                0178        ENDDO
                0179        fnamebase = xx_genarr3d_file(iarr)
                0180        il=ILNBLNK( fnamebase )
de57a2ec4b Mart*0181        WRITE(fnamegeneric,'(2A,I10.10)')
2e7aec9951 dngo*0182      &     fnamebase(1:il),'.',optimcycle
                0183        CALL ACTIVE_READ_XYZ( fnamegeneric, tmpfld3d, 1,
                0184      &                       doglobalread, ladinit, optimcycle,
                0185      &                       myThid, xx_genarr3d_dummy(iarr) )
                0186        IF ( iarr .EQ. 1 ) THEN
                0187         DO bj=myByLo(myThid), myByHi(myThid)
                0188          DO bi=myBxLo(myThid), myBxHi(myThid)
                0189           DO k = 1,Nr
                0190            DO j = 1,sNy
                0191             DO i = 1,sNx
                0192              theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
                0193      &         + fac*tmpfld3d(i,j,k,bi,bj)
                0194 #ifdef PREVENT_TOO_COLD_TEMP
                0195 C     necessary to reproduce old results
                0196              IF ( theta(i,j,k,bi,bj).LT.-2.0 _d 0 )
                0197      &            theta(i,j,k,bi,bj) = -2.0 _d 0
                0198 #endif
                0199             ENDDO
                0200            ENDDO
                0201           ENDDO
                0202          ENDDO
                0203         ENDDO
                0204         CALL EXCH_3D_RL( theta, Nr, myThid )
                0205        ELSEIF ( iarr .EQ. 2 ) THEN
                0206         DO bj=myByLo(myThid), myByHi(myThid)
                0207          DO bi=myBxLo(myThid), myBxHi(myThid)
                0208           DO k = 1,Nr
                0209            DO j = 1,sNy
                0210             DO i = 1,sNx
                0211              salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
                0212      &         + fac*tmpfld3d(i,j,k,bi,bj)
                0213             ENDDO
                0214            ENDDO
                0215           ENDDO
                0216          ENDDO
                0217         ENDDO
                0218         CALL EXCH_3D_RL( salt, Nr, myThid )
                0219 #ifdef ALLOW_3D_DIFFKR
                0220        ELSEIF ( iarr .EQ. 3 ) THEN
                0221         DO bj=myByLo(myThid), myByHi(myThid)
                0222          DO bi=myBxLo(myThid), myBxHi(myThid)
                0223           DO k = 1,Nr
                0224            DO j = 1,sNy
                0225             DO i = 1,sNx
                0226              diffKr(i,j,k,bi,bj) = diffKr(i,j,k,bi,bj)
                0227      &         + fac*tmpfld3d(i,j,k,bi,bj)
                0228             ENDDO
                0229            ENDDO
                0230           ENDDO
                0231          ENDDO
                0232         ENDDO
                0233         CALL EXCH_3D_RL( diffKr, Nr, myThid )
                0234 #endif
                0235       ENDIF
                0236
                0237 C--   end iarr loop
                0238       ENDDO
                0239
                0240 #endif /* ALLOW_GENARR3D_CONTROL */
                0241
                0242       RETURN
                0243       END