** Warning **

Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.

Last-Modified: Sun, 7 Sep 2024 05:11:39 GMT Content-Type: text/html; charset=utf-8 MITgcm/MITgcm/verification/tutorial_global_oce_biogeo/code_oad/ctrl_map_ini_genarr.F
Back to home page

MITgcm
 
 

    

File indexing completed on 2023-11-05 05:11:25 UTC

view on githubraw file Latest commit 65754df4 on 2023-11-04 17:55:24 UTC
e85a34039f Oliv*0001 #include "CTRL_OPTIONS.h"
2e7aec9951 dngo*0002 #define PREVENT_TOO_COLD_TEMP
e85a34039f Oliv*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".
e85a34039f Oliv*0015 C     *=================================================================
2e7aec9951 dngo*0016 C     | local version for OpenAD exp. tutorial_global_oce_biogeo and
                0017 C     |   tutorial_tracer_adjsens
                0018 C     *=================================================================
e85a34039f Oliv*0019 C     \ev
                0020 
                0021 C     !USES:
                0022       IMPLICIT NONE
                0023 
                0024 C     == global variables ==
                0025 #include "SIZE.h"
                0026 #include "EEPARAMS.h"
                0027 #include "PARAMS.h"
                0028 #include "GRID.h"
                0029 #include "DYNVARS.h"
                0030 #include "FFIELDS.h"
                0031 #include "CTRL_SIZE.h"
4d72283393 Mart*0032 #include "CTRL.h"
e85a34039f Oliv*0033 #include "CTRL_GENARR.h"
edcd27be69 Mart*0034 #include "CTRL_DUMMY.h"
65754df434 Mart*0035 #include "OPTIMCYCLE.h"
e85a34039f Oliv*0036 #ifdef ALLOW_PTRACERS
                0037 # include "PTRACERS_SIZE.h"
                0038 c#include "PTRACERS_PARAMS.h"
                0039 # include "PTRACERS_FIELDS.h"
                0040 #endif
                0041 
                0042 C     !INPUT/OUTPUT PARAMETERS:
                0043 C     == routine arguments ==
                0044       INTEGER myThid
                0045 
                0046 C     !FUNCTIONS:
                0047       INTEGER  ILNBLNk
                0048       EXTERNAL ILNBLNK
                0049 
                0050 C     !LOCAL VARIABLES:
                0051 C     == local variables ==
2e7aec9951 dngo*0052       INTEGER bi,bj
                0053       INTEGER i,j,k
                0054       INTEGER il
                0055       INTEGER iarr, iptr
                0056 
                0057       LOGICAL doglobalread
                0058       LOGICAL ladinit
                0059       CHARACTER*(MAX_LEN_FNAM) fnamebase
de57a2ec4b Mart*0060       CHARACTER*(MAX_LEN_FNAM) fnamegeneric
2e7aec9951 dngo*0061       CHARACTER*(MAX_LEN_MBUF) msgBuf
e85a34039f Oliv*0062       _RL     fac
7c50f07931 Mart*0063 #ifdef ALLOW_GENARR2D_CONTROL
2e7aec9951 dngo*0064       _RL     tmpfld2d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,   nSx,nSy)
7c50f07931 Mart*0065 #endif
                0066 #ifdef ALLOW_GENARR3D_CONTROL
2e7aec9951 dngo*0067       _RL     tmpfld3d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
7c50f07931 Mart*0068 #endif
e85a34039f Oliv*0069 CEOP
                0070 
2e7aec9951 dngo*0071       doglobalread = .FALSE.
                0072       ladinit      = .FALSE.
e85a34039f Oliv*0073       fac = 1. _d 0
                0074 
                0075 #ifdef ALLOW_GENARR2D_CONTROL
                0076 C--   An example of connecting specific fields
                0077 C--   to 3 generic 2D control arrays
                0078 cc--->>>
                0079 cc--->>> COMPILE FAILURE IS DELIBERATE
                0080 cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
                0081 cc--->>>
                0082 C--   generic - user-defined control vars
                0083       DO iarr = 1, maxCtrlArr2D
                0084 
2e7aec9951 dngo*0085 C     These forcing control variables are constant in time for this
                0086 C     experiment, so that we can specify them here. Once we know how to
                0087 C     make OpenAD use the gentim2d controls, these should be handled via
                0088 C     ctrl_map_gentim2d.F
                0089        DO bj=myByLo(myThid), myByHi(myThid)
                0090         DO bi=myBxLo(myThid), myBxHi(myThid)
                0091          DO j = 1,sNy
                0092           DO i = 1,sNx
                0093            tmpfld2d(i,j,bi,bj) = 0. _d 0
                0094           ENDDO
                0095          ENDDO
                0096         ENDDO
                0097        ENDDO
e85a34039f Oliv*0098        fnamebase = xx_genarr2d_file(iarr)
                0099        il=ILNBLNK( fnamebase )
de57a2ec4b Mart*0100        WRITE(fnamegeneric,'(2A,I10.10)')
e85a34039f Oliv*0101      &     fnamebase(1:il),'.',optimcycle
                0102        CALL ACTIVE_READ_XY ( fnamegeneric, tmpfld2d, 1,
                0103      &                      doglobalread, ladinit, optimcycle,
                0104      &                      myThid, xx_genarr2d_dummy(iarr) )
2e7aec9951 dngo*0105        IF ( iarr .EQ. 1 ) THEN
                0106         DO bj=myByLo(myThid), myByHi(myThid)
                0107          DO bi=myBxLo(myThid), myBxHi(myThid)
                0108           DO j = 1,sNy
                0109            DO i = 1,sNx
                0110             qnet(i,j,bi,bj) = qnet(i,j,bi,bj)
                0111      &           + fac*tmpfld2d(i,j,bi,bj)
                0112            ENDDO
                0113           ENDDO
                0114          ENDDO
e85a34039f Oliv*0115         ENDDO
2e7aec9951 dngo*0116        ELSEIF ( iarr .EQ. 2 ) THEN
                0117         DO bj=myByLo(myThid), myByHi(myThid)
                0118          DO bi=myBxLo(myThid), myBxHi(myThid)
                0119           DO j = 1,sNy
                0120            DO i = 1,sNx
                0121             empmr(i,j,bi,bj) = empmr(i,j,bi,bj)
                0122      &           + fac*tmpfld2d(i,j,bi,bj)
                0123            ENDDO
                0124           ENDDO
                0125          ENDDO
                0126         ENDDO
                0127        ELSEIF ( iarr .EQ. 3 ) THEN
                0128         DO bj=myByLo(myThid), myByHi(myThid)
                0129          DO bi=myBxLo(myThid), myBxHi(myThid)
                0130           DO j = 1,sNy
                0131            DO i = 1,sNx
                0132             fu(i,j,bi,bj) = fu(i,j,bi,bj)
                0133      &           + fac*tmpfld2d(i,j,bi,bj)
                0134            ENDDO
                0135           ENDDO
                0136          ENDDO
                0137         ENDDO
                0138        ELSEIF ( iarr .EQ. 4 ) THEN
                0139         DO bj=myByLo(myThid), myByHi(myThid)
                0140          DO bi=myBxLo(myThid), myBxHi(myThid)
                0141           DO j = 1,sNy
                0142            DO i = 1,sNx
                0143             fv(i,j,bi,bj) = fv(i,j,bi,bj)
                0144      &           + fac*tmpfld2d(i,j,bi,bj)
                0145            ENDDO
                0146           ENDDO
                0147          ENDDO
                0148         ENDDO
                0149        ENDIF
e85a34039f Oliv*0150 C--   end iarr loop
                0151       ENDDO
2e7aec9951 dngo*0152       _EXCH_XY_RS( qnet,  myThid )
                0153       _EXCH_XY_RS( empmr, myThid )
                0154       CALL EXCH_UV_XY_RS(fu,fv,.TRUE.,myThid)
e85a34039f Oliv*0155 
                0156 #endif /* ALLOW_GENARR2D_CONTROL */
                0157 
                0158 #ifdef ALLOW_GENARR3D_CONTROL
                0159 C--   An example of connecting specific fields
                0160 C--   to 3 generic 3D control arrays
                0161 cc--->>>
                0162 cc--->>> COMPILE FAILURE IS DELIBERATE
                0163 cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
                0164 cc--->>>
                0165 cc
                0166 cc A CONSISTENCY CHECK: FOR THIS CUSTOMIZATION
2e7aec9951 dngo*0167 cc WE ASSUME maxCtrlArr3D-3 <= PTRACERS_num
e85a34039f Oliv*0168 cc
2e7aec9951 dngo*0169       IF ( maxCtrlArr3D-3 .GT. PTRACERS_num ) THEN
699e96b1ba Jean*0170         WRITE(msgBuf,'(A)')
2e7aec9951 dngo*0171      &   'CTRL_MAP_INI_GENARR: need maxCtrlArr3D-3 <= PTRACERS_num'
e85a34039f Oliv*0172         CALL PRINT_ERROR( msgBuf, myThid )
                0173         STOP 'ABNORMAL END: S/R CTRL_MAP_INI_GENARR'
                0174       ENDIF
                0175 
                0176 C--   generic - user-defined control vars
                0177       DO iarr = 1, maxCtrlArr3D
                0178 
2e7aec9951 dngo*0179        DO bj=myByLo(myThid), myByHi(myThid)
                0180         DO bi=myBxLo(myThid), myBxHi(myThid)
                0181          DO k = 1,Nr
                0182           DO j = 1,sNy
                0183            DO i = 1,sNx
                0184             tmpfld3d(i,j,k,bi,bj) = 0. _d 0
                0185            ENDDO
                0186           ENDDO
                0187          ENDDO
                0188         ENDDO
                0189        ENDDO
e85a34039f Oliv*0190        fnamebase = xx_genarr3d_file(iarr)
                0191        il=ILNBLNK( fnamebase )
de57a2ec4b Mart*0192        WRITE(fnamegeneric,'(2A,I10.10)')
e85a34039f Oliv*0193      &     fnamebase(1:il),'.',optimcycle
                0194        CALL ACTIVE_READ_XYZ( fnamegeneric, tmpfld3d, 1,
                0195      &                       doglobalread, ladinit, optimcycle,
                0196      &                       myThid, xx_genarr3d_dummy(iarr) )
2e7aec9951 dngo*0197        IF ( iarr .EQ. 1 ) THEN
                0198         DO bj=myByLo(myThid), myByHi(myThid)
                0199          DO bi=myBxLo(myThid), myBxHi(myThid)
                0200           DO k = 1,Nr
                0201            DO j = 1,sNy
                0202             DO i = 1,sNx
                0203              theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
e85a34039f Oliv*0204      &         + fac*tmpfld3d(i,j,k,bi,bj)
2e7aec9951 dngo*0205 #ifdef PREVENT_TOO_COLD_TEMP
                0206 C     necessary to reproduce old results
                0207              IF ( theta(i,j,k,bi,bj).LT.-2.0 _d 0 )
                0208      &            theta(i,j,k,bi,bj) = -2.0 _d 0
                0209 #endif
                0210             ENDDO
                0211            ENDDO
                0212           ENDDO
                0213          ENDDO
e85a34039f Oliv*0214         ENDDO
2e7aec9951 dngo*0215         CALL EXCH_3D_RL( theta, Nr, myThid )
                0216        ELSEIF ( iarr .EQ. 2 ) THEN
                0217         DO bj=myByLo(myThid), myByHi(myThid)
                0218          DO bi=myBxLo(myThid), myBxHi(myThid)
                0219           DO k = 1,Nr
                0220            DO j = 1,sNy
                0221             DO i = 1,sNx
                0222              salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
                0223      &         + fac*tmpfld3d(i,j,k,bi,bj)
                0224             ENDDO
                0225            ENDDO
                0226           ENDDO
                0227          ENDDO
                0228         ENDDO
                0229         CALL EXCH_3D_RL( salt, Nr, myThid )
                0230        ELSEIF ( iarr .EQ. 3 ) THEN
                0231         DO bj=myByLo(myThid), myByHi(myThid)
                0232          DO bi=myBxLo(myThid), myBxHi(myThid)
                0233           DO k = 1,Nr
                0234            DO j = 1,sNy
                0235             DO i = 1,sNx
                0236              diffKr(i,j,k,bi,bj) = diffKr(i,j,k,bi,bj)
                0237      &         + fac*tmpfld3d(i,j,k,bi,bj)
                0238             ENDDO
                0239            ENDDO
                0240           ENDDO
                0241          ENDDO
                0242         ENDDO
                0243         CALL EXCH_3D_RL( diffKr, Nr, myThid )
                0244        ELSEIF ( iarr .EQ. 4 ) THEN
                0245         iptr = iarr-3
                0246         DO bj=myByLo(myThid), myByHi(myThid)
                0247          DO bi=myBxLo(myThid), myBxHi(myThid)
                0248           DO k = 1,Nr
                0249            DO j = 1,sNy
                0250             DO i = 1,sNx
                0251              pTracer(i,j,k,bi,bj,iptr) = pTracer(i,j,k,bi,bj,iptr)
                0252      &         + fac*tmpfld3d(i,j,k,bi,bj)
                0253             ENDDO
                0254            ENDDO
                0255           ENDDO
                0256          ENDDO
                0257         ENDDO
                0258         CALL EXCH_3D_RL( pTracer(1-OLx,1-OLy,1,1,1,iptr),
e85a34039f Oliv*0259      &                  Nr, myThid )
2e7aec9951 dngo*0260       ENDIF
                0261 
e85a34039f Oliv*0262 C--   end iarr loop
                0263       ENDDO
                0264 
                0265 #endif /* ALLOW_GENARR3D_CONTROL */
                0266 
                0267       RETURN
                0268       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!