Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:36:46 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
11d11fd6da Jean*0001 #include "PACKAGES_CONFIG.h"
1dbaea09ee Chri*0002 #include "CPP_OPTIONS.h"
924557e60a Chri*0003 
9366854e02 Chri*0004 CBOP
                0005 C     !ROUTINE: INI_CORI
b6356366ca Ed H*0006 
9366854e02 Chri*0007 C     !INTERFACE:
924557e60a Chri*0008       SUBROUTINE INI_CORI( myThid )
b6356366ca Ed H*0009 C     !DESCRIPTION:
dfef4f457e Jean*0010 C     Initialise coriolis term.
924557e60a Chri*0011 
9366854e02 Chri*0012 C     !USES:
                0013       IMPLICIT NONE
924557e60a Chri*0014 #include "SIZE.h"
                0015 #include "EEPARAMS.h"
                0016 #include "PARAMS.h"
dfef4f457e Jean*0017 #include "GRID.h"
33a3e71e59 Jean*0018 #ifdef ALLOW_EXCH2
1cc6effca6 Jean*0019 # include "W2_EXCH2_SIZE.h"
33a3e71e59 Jean*0020 # include "W2_EXCH2_TOPOLOGY.h"
                0021 #endif
f31930e56f Ed H*0022 #ifdef ALLOW_MNC
33a3e71e59 Jean*0023 # include "MNC_PARAMS.h"
f31930e56f Ed H*0024 #endif
b6356366ca Ed H*0025 #ifdef ALLOW_MONITOR
33a3e71e59 Jean*0026 # include "MONITOR.h"
b6356366ca Ed H*0027 #endif
924557e60a Chri*0028 
9366854e02 Chri*0029 C     !INPUT/OUTPUT PARAMETERS:
c07cd3bfa8 Jean*0030 C     myThid  :: my Thread Id number
924557e60a Chri*0031       INTEGER myThid
b6356366ca Ed H*0032 CEOP
924557e60a Chri*0033 
49aab2cab9 Jean*0034 C     === Functions ====
                0035       LOGICAL  MASTER_CPU_IO
                0036       EXTERNAL MASTER_CPU_IO
                0037 
9366854e02 Chri*0038 C     !LOCAL VARIABLES:
dfef4f457e Jean*0039 C     bi,bj   :: Tile Indices counters
                0040 C     i, j    :: Loop counters
                0041 C     facGrid :: Factor for grid to meter conversion
                0042       INTEGER bi,bj
                0043       INTEGER i, j
924557e60a Chri*0044       _RL facGrid
33a3e71e59 Jean*0045 #ifndef OLD_GRID_IO
                0046       INTEGER myTile, iG, iLen
                0047       CHARACTER*(MAX_LEN_FNAM) fName
                0048       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0049       INTEGER  ILNBLNK
                0050       EXTERNAL ILNBLNK
                0051 #endif
                0052 
924557e60a Chri*0053 
b6356366ca Ed H*0054 C     Initialise coriolis parameter
c07cd3bfa8 Jean*0055       IF     ( selectCoriMap.EQ.0 ) THEN
b6356366ca Ed H*0056 C       Constant F case
                0057         DO bj = myByLo(myThid), myByHi(myThid)
                0058           DO bi = myBxLo(myThid), myBxHi(myThid)
dfef4f457e Jean*0059             DO j=1-Oly,sNy+Oly
                0060               DO i=1-Olx,sNx+Olx
                0061                 fCori(i,j,bi,bj)  = f0
                0062                 fCoriG(i,j,bi,bj) = f0
c07cd3bfa8 Jean*0063                 fCoriCos(i,j,bi,bj)=fPrime
b6356366ca Ed H*0064               ENDDO
dfef4f457e Jean*0065             ENDDO
924557e60a Chri*0066           ENDDO
                0067         ENDDO
c07cd3bfa8 Jean*0068       ELSEIF ( selectCoriMap.EQ.1 ) THEN
b6356366ca Ed H*0069 C       Beta plane case
                0070         facGrid = 1. _d 0
dfef4f457e Jean*0071         IF ( usingSphericalPolarGrid
                0072      &     .OR. usingCurvilinearGrid ) facGrid = deg2rad*rSphere
b6356366ca Ed H*0073         DO bj = myByLo(myThid), myByHi(myThid)
                0074           DO bi = myBxLo(myThid), myBxHi(myThid)
dfef4f457e Jean*0075             DO j=1-Oly,sNy+Oly
                0076               DO i=1-Olx,sNx+Olx
                0077                 fCori(i,j,bi,bj)  = f0+beta*_yC(i,j,bi,bj)*facGrid
                0078                 fCoriG(i,j,bi,bj) = f0+beta* yG(i,j,bi,bj)*facGrid
c07cd3bfa8 Jean*0079                 fCoriCos(i,j,bi,bj)=fPrime
b6356366ca Ed H*0080               ENDDO
dfef4f457e Jean*0081             ENDDO
b05b067368 Chri*0082           ENDDO
                0083         ENDDO
c07cd3bfa8 Jean*0084       ELSEIF ( selectCoriMap.EQ.2 ) THEN
b6356366ca Ed H*0085 C       Spherical case
                0086 C       Note in this case we assume yC is in degrees.
                0087         DO bj = myByLo(myThid), myByHi(myThid)
                0088           DO bi = myBxLo(myThid), myBxHi(myThid)
dfef4f457e Jean*0089             DO j=1-Oly,sNy+Oly
                0090               DO i=1-Olx,sNx+Olx
                0091                 fCori(i,j,bi,bj)  =
b6356366ca Ed H*0092      &                 2. _d 0*omega*sin(_yC(i,j,bi,bj)*deg2rad)
dfef4f457e Jean*0093                 fCoriG(i,j,bi,bj) =
b6356366ca Ed H*0094      &                 2. _d 0*omega*sin(yG(i,j,bi,bj)*deg2rad)
dfef4f457e Jean*0095                 fCoriCos(i,j,bi,bj)=
b6356366ca Ed H*0096      &                 2. _d 0*omega*cos(_yC(i,j,bi,bj)*deg2rad)
                0097               ENDDO
dfef4f457e Jean*0098             ENDDO
b05b067368 Chri*0099           ENDDO
                0100         ENDDO
738f74f342 Jean*0101 c       CALL WRITE_FLD_XY_RL('fCoriC',' ',fCori ,  0,myThid)
                0102 c       CALL WRITE_FLD_XY_RL('fCoriG',' ',fCoriG , 0,myThid)
                0103 c       CALL WRITE_FLD_XY_RL('fCorCs',' ',fCoriCos,0,myThid)
b05b067368 Chri*0104       ELSE
c07cd3bfa8 Jean*0105 C       Initialise to zero
b6356366ca Ed H*0106         DO bj = myByLo(myThid), myByHi(myThid)
                0107           DO bi = myBxLo(myThid), myBxHi(myThid)
dfef4f457e Jean*0108             DO j=1-Oly,sNy+Oly
                0109               DO i=1-Olx,sNx+Olx
                0110                 fCori(i,j,bi,bj)  = 0. _d 0
                0111                 fCoriG(i,j,bi,bj) = 0. _d 0
                0112                 fCoriCos(i,j,bi,bj)=0. _d 0
b6356366ca Ed H*0113               ENDDO
dfef4f457e Jean*0114             ENDDO
b05b067368 Chri*0115           ENDDO
                0116         ENDDO
c07cd3bfa8 Jean*0117       ENDIF
                0118 
                0119       IF ( selectCoriMap.EQ.3 ) THEN
                0120 C     Special custom form: read from files
738f74f342 Jean*0121         CALL READ_REC_XY_RS( 'fCoriC.bin', fCori,   1, 0, myThid )
                0122         CALL READ_REC_XY_RS( 'fCorCs.bin', fCoriCos,1, 0, myThid )
33a3e71e59 Jean*0123         IF ( .NOT.useCubedSphereExchange ) THEN
                0124          CALL READ_REC_XY_RS('fCoriG.bin', fCoriG,  1, 0, myThid )
                0125         ELSE
                0126 #ifdef OLD_GRID_IO
                0127          CALL READ_REC_XY_RS('fCoriG.bin', fCoriG,  1, 0, myThid )
738f74f342 Jean*0128 C-       deal with the 2 missing corners (for fCoriG):
                0129          DO bj = myByLo(myThid), myByHi(myThid)
                0130           DO bi = myBxLo(myThid), myBxHi(myThid)
                0131 C-  Notes: this will only works with 6 tiles (1 per face) and
                0132 C    with 2 polar faces + 4 equatorials:
                0133            IF (bi.LE.3 .OR. bi.GE.5) THEN
                0134              fCoriG(sNx+1,1,bi,bj) = fCoriG(1,1,bi,bj)
                0135            ELSE
                0136              fCoriG(sNx+1,1,bi,bj) = -fCoriG(1,1,bi,bj)
                0137            ENDIF
                0138            IF (bi.GE.3) THEN
                0139              fCoriG(1,sNy+1,bi,bj) = fCoriG(1,1,bi,bj)
                0140              fCoriG(sNx+1,sNy+1,bi,bj) = fCoriG(sNx+1,1,bi,bj)
                0141            ELSE
                0142              fCoriG(1,sNy+1,bi,bj) = -fCoriG(1,1,bi,bj)
                0143              fCoriG(sNx+1,sNy+1,bi,bj) = -fCoriG(sNx+1,1,bi,bj)
                0144            ENDIF
                0145           ENDDO
                0146          ENDDO
33a3e71e59 Jean*0147 #else  /* OLD_GRID_IO */
                0148          _BEGIN_MASTER(myThid)
                0149          DO bj = 1,nSy
                0150           DO bi = 1,nSx
                0151            iG = bi+(myXGlobalLo-1)/sNx
                0152            myTile = iG
                0153 #ifdef ALLOW_EXCH2
8adbfea2f8 Jean*0154            myTile = W2_myTileList(bi,bj)
33a3e71e59 Jean*0155            iG = exch2_myface(myTile)
                0156 #endif
                0157            WRITE(fName,'(2A,I3.3,A)') 'fCoriG','.face',iG,'.bin'
                0158            iLen = ILNBLNK(fName)
                0159            WRITE(msgBuf,'(A,I6,2A)')
                0160      &       ' Reading tile:', myTile, ' from file ', fName(1:iLen)
                0161            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0162      &                         SQUEEZE_RIGHT , myThid )
                0163 #ifdef ALLOW_MDSIO
                0164            CALL MDS_FACEF_READ_RS( fName, readBinaryPrec, 1,
                0165      &                             fCoriG, bi, bj, myThid )
                0166 #else /* ALLOW_MDSIO */
                0167            WRITE(msgBuf,'(A)') 'INI_CORI: Needs to compile MDSIO pkg'
                0168            CALL PRINT_ERROR( msgBuf, myThid )
                0169            STOP 'ABNORMAL END: S/R INI_CORI'
                0170 #endif /* ALLOW_MDSIO */
                0171 
                0172           ENDDO
                0173          ENDDO
                0174          _END_MASTER(myThid)
                0175 #endif /* OLD_GRID_IO */
738f74f342 Jean*0176         ENDIF
                0177 
a8d7de28cd Jean*0178         CALL EXCH_XY_RS( fCori, myThid )
                0179         CALL EXCH_XY_RS( fCoriCos, myThid )
                0180         CALL EXCH_Z_3D_RS( fCoriG, 1, myThid )
b05b067368 Chri*0181       ENDIF
924557e60a Chri*0182 
ffced37781 Ed H*0183 #ifdef ALLOW_MONITOR
49aab2cab9 Jean*0184       IF ( MASTER_CPU_IO(myThid) ) THEN
dfef4f457e Jean*0185 C--   only the master thread is allowed to switch On/Off mon_write_stdout
ff02675122 Jean*0186 C     & mon_write_mnc (since it is the only thread that uses those flags):
dfef4f457e Jean*0187 
                0188         IF (monitor_stdio) THEN
                0189           mon_write_stdout = .TRUE.
                0190         ELSE
                0191           mon_write_stdout = .FALSE.
                0192         ENDIF
                0193         mon_write_mnc = .FALSE.
b6356366ca Ed H*0194 #ifdef ALLOW_MNC
dfef4f457e Jean*0195         IF (useMNC .AND. monitor_mnc) THEN
                0196           DO i = 1,MAX_LEN_MBUF
                0197             mon_fname(i:i) = ' '
                0198           ENDDO
                0199           mon_fname(1:12) = 'monitor_grid'
                0200           CALL MNC_CW_SET_UDIM(mon_fname, 1, myThid)
                0201           mon_write_mnc = .TRUE.
                0202         ENDIF
b6356366ca Ed H*0203 #endif /*  ALLOW_MNC  */
dfef4f457e Jean*0204 
                0205       ENDIF
                0206 
d3653d5831 Jean*0207       CALL MON_SET_PREF( mon_string_none, myThid )
c10dd767c9 Alis*0208       CALL MON_PRINTSTATS_RS(1,fCori,'fCori',myThid)
                0209       CALL MON_PRINTSTATS_RS(1,fCoriG,'fCoriG',myThid)
e08dd1974e Alis*0210       CALL MON_PRINTSTATS_RS(1,fCoriCos,'fCoriCos',myThid)
b6356366ca Ed H*0211 
49aab2cab9 Jean*0212       IF ( MASTER_CPU_IO(myThid) ) THEN
dfef4f457e Jean*0213         mon_write_stdout = .FALSE.
                0214         mon_write_mnc    = .FALSE.
                0215       ENDIF
                0216 #endif /* ALLOW_MONITOR */
c10dd767c9 Alis*0217 
924557e60a Chri*0218       RETURN
                0219       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!