Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:40:18 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
c83e0242d5 Ed H*0001 #include "FIZHI_OPTIONS.h"
                0002 
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP 0
                0005 C     !ROUTINE: FIZHI_MNC_INIT
                0006 
                0007 C     !INTERFACE:
f9c065a827 Ed H*0008       SUBROUTINE FIZHI_MNC_INIT( myThid )
c83e0242d5 Ed H*0009 
                0010 C     !DESCRIPTION:
f9c065a827 Ed H*0011 C     Create some pre-defined MNC grid types and variable types useful
                0012 C     for the FIZHI package.  Borrows heavily from MNC_CW_INIT().
c83e0242d5 Ed H*0013 
f9c065a827 Ed H*0014 C     !USES:
7aae1e039f Andr*0015       implicit none
f9c065a827 Ed H*0016 #include "SIZE.h"
                0017 #include "fizhi_SIZE.h"
                0018 #include "fizhi_land_SIZE.h"
1279bcbdce Ed H*0019 #include "EEPARAMS.h"
a0355f4264 Ed H*0020 #include "PARAMS.h"
580dd6560d Ed H*0021 #ifdef ALLOW_MNC
                0022 #include "MNC_PARAMS.h"
51f3863fef Mart*0023 #include "MNC_COMMON.h"
580dd6560d Ed H*0024 #endif
f9c065a827 Ed H*0025 
c83e0242d5 Ed H*0026 C     !INPUT PARAMETERS:
                0027       integer myThid
                0028 CEOP
                0029 
                0030 #ifdef ALLOW_MNC
                0031 
                0032 C     !LOCAL VARIABLES:
                0033       integer CW_MAX_LOC
                0034       parameter ( CW_MAX_LOC = 5 )
                0035       integer i, ihorz,ihsub,ivert,itime,ihalo, is,ih, n,ntot
                0036       integer ndim, ncomb, nvch
                0037       character*(MNC_MAX_CHAR) name
                0038       character*(MNC_MAX_CHAR) dn(CW_MAX_LOC)
                0039       character*(5) horz_dat(CW_MAX_LOC), hsub_dat(CW_MAX_LOC),
                0040      &     vert_dat(CW_MAX_LOC), time_dat(CW_MAX_LOC), 
                0041      &     halo_dat(CW_MAX_LOC)
                0042       integer dim(CW_MAX_LOC), ib(CW_MAX_LOC), ie(CW_MAX_LOC)
                0043 
                0044 C     Functions
                0045       integer ILNBLNK
                0046       external ILNBLNK
                0047 
                0048 C     ......12345....12345....12345....12345....12345...
                0049       data horz_dat /
                0050      &     '-    ', 'U    ', 'V    ', 'Cen  ', 'Cor  '  /
                0051       data hsub_dat /
                0052      &     'xy   ', 'x    ', 'y    ', '-    ', '     '  /
                0053       data halo_dat /
                0054      &     'Hn   ', 'Hy   ', '--   ', '     ', '     '  /
                0055       data vert_dat /
                0056      &     'Zph  ', 'Zphi ', '     ', '     ', '     '  /
                0057       data time_dat /
                0058      &     '-    ', 't    ', '     ', '     ', '     '  /
                0059 
580dd6560d Ed H*0060       IF (useMNC) THEN
                0061 
f9c065a827 Ed H*0062 C     Define a few "standard" or "convenience" types
c83e0242d5 Ed H*0063       ncomb = 0
                0064       DO ihorz = 1,5
                0065         DO is = 1,3
                0066           DO ih = 1,2
                0067             
                0068 C           Loop just ONCE if the Horiz component is "-"
                0069             ihsub = is
                0070             ihalo = ih
                0071             IF (ihorz .EQ. 1) THEN
                0072               IF ((is .EQ. 1) .AND. (ih .EQ. 1)) THEN
                0073                 ihsub = 4
                0074                 ihalo = 3
                0075               ELSE
                0076                 GOTO 10
                0077               ENDIF
                0078             ENDIF
                0079             
3055168833 Ed H*0080             DO ivert = 1,2
c83e0242d5 Ed H*0081               DO itime = 1,2
                0082                 
                0083 C               horiz and hsub
                0084                 name(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
                0085                 n = ILNBLNK(horz_dat(ihorz))
                0086                 name(1:n) = horz_dat(ihorz)(1:n)
                0087                 ntot = n + 1              
                0088                 name(ntot:ntot) = '_'
                0089                 n = ILNBLNK(hsub_dat(ihsub))
                0090                 name((ntot+1):(ntot+n)) = hsub_dat(ihsub)(1:n)
                0091                 ntot = ntot + n
                0092 
                0093 C               halo, vert, and time
                0094                 write(name((ntot+1):(ntot+5)), '(a1,2a2)')
                0095      &               '_', halo_dat(ihalo)(1:2), '__'
                0096                 nvch = ILNBLNK(vert_dat(ivert))
                0097                 n = ntot+6+nvch-1
                0098                 name((ntot+6):(n)) = vert_dat(ivert)(1:nvch)
                0099                 write(name((n+1):(n+3)), '(a2,a1)') 
                0100      &               '__', time_dat(itime)(1:1)
                0101 
                0102                 ndim = 0
                0103                 DO i = 1,CW_MAX_LOC
                0104                   dn(i)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
                0105                   dim(i) = 0
                0106                   ib(i) = 0
                0107                   ie(i) = 0
                0108                 ENDDO
                0109 
                0110 C               Horizontal dimensions
                0111                 IF (halo_dat(ihalo)(1:5) .EQ. 'Hn   ') THEN
                0112 
                0113                   IF (hsub_dat(ihsub)(1:1) .EQ. 'x') THEN
                0114                     ndim = ndim + 1
                0115                     IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cen')
                0116      &                   .OR. (horz_dat(ihorz)(1:1) .EQ. 'V') ) THEN
                0117                       dn(ndim)(1:1) = 'X'
                0118                       dim(ndim) = sNx + 2*OLx
                0119                       ib(ndim)  = OLx + 1
                0120                       ie(ndim)  = OLx + sNx
                0121                     ENDIF
                0122                     IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cor')
                0123      &                   .OR. (horz_dat(ihorz)(1:1) .EQ. 'U') ) THEN
                0124                       dn(ndim)(1:3) = 'Xp1'
                0125                       dim(ndim) = sNx + 2*OLx
                0126                       ib(ndim)  = OLx + 1
                0127                       ie(ndim)  = OLx + sNx + 1
                0128                     ENDIF
                0129                   ENDIF
                0130                   IF ((hsub_dat(ihsub)(1:1) .EQ. 'y')
                0131      &                 .OR. (hsub_dat(ihsub)(2:2) .EQ. 'y')) THEN
                0132                     ndim = ndim + 1
                0133                     IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cen')
                0134      &                   .OR. (horz_dat(ihorz)(1:1) .EQ. 'U') ) THEN
                0135                       dn(ndim)(1:1) = 'Y'
                0136                       dim(ndim) = sNy + 2*OLy
                0137                       ib(ndim)  = OLy + 1
                0138                       ie(ndim)  = OLy + sNy
                0139                     ENDIF
                0140                     IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cor')
                0141      &                   .OR. (horz_dat(ihorz)(1:1) .EQ. 'V') ) THEN
                0142                       dn(ndim)(1:3) = 'Yp1'
                0143                       dim(ndim) = sNy + 2*OLy
                0144                       ib(ndim)  = OLy + 1
                0145                       ie(ndim)  = OLy + sNy + 1
                0146                     ENDIF
                0147                   ENDIF
                0148 
                0149                 ELSEIF (halo_dat(ihalo)(1:5) .EQ. 'Hy   ') THEN
                0150 
                0151                   IF (hsub_dat(ihsub)(1:1) .EQ. 'x') THEN
                0152                     ndim = ndim + 1
                0153                     dn(ndim)(1:3) = 'Xwh'
                0154                     dim(ndim) = sNx + 2*OLx
                0155                     ib(ndim)  = 1
                0156                     ie(ndim)  = sNx + 2*OLx
                0157                   ENDIF
                0158                   IF ((hsub_dat(ihsub)(1:1) .EQ. 'y')
                0159      &                 .OR. (hsub_dat(ihsub)(2:2) .EQ. 'y')) THEN
                0160                     ndim = ndim + 1
                0161                     dn(ndim)(1:3) = 'Ywh'
                0162                     dim(ndim) = sNy + 2*OLy
                0163                     ib(ndim)  = 1
                0164                     ie(ndim)  = sNy + 2*OLy
                0165                   ENDIF
                0166 
                0167                 ENDIF
                0168 
                0169 C               Vertical dimension
                0170                 IF (vert_dat(ivert)(1:5) .EQ. 'Phys ') THEN
                0171                   ndim = ndim + 1
                0172                   dn(ndim)(1:5) = 'Zphys'
                0173                   dim(ndim) = NrPhys
                0174                   ib(ndim)  = 1
                0175                   ie(ndim)  = NrPhys
                0176                 ENDIF
                0177                 IF (vert_dat(ivert)(1:5) .EQ. 'PhysI') THEN
                0178                   ndim = ndim + 1
                0179                   dn(ndim)(1:7) = 'Zphysm1'
                0180                   dim(ndim) = NrPhys - 1
                0181                   ib(ndim)  = 1
                0182                   ie(ndim)  = NrPhys - 1
                0183                 ENDIF
                0184 
                0185 C               Time dimension
                0186                 IF ( (time_dat(itime)(1:1) .EQ. 't')
                0187      &               .and. (ndim .ne. 0) ) THEN
                0188                   ndim = ndim + 1
                0189                   dn(ndim)(1:1) = 'T'
                0190                   dim(ndim) = -1
                0191                   ib(ndim)  = 1
                0192                   ie(ndim)  = 1
                0193                 ENDIF
                0194 
                0195                 IF (ndim .GT. 0) THEN
                0196 
                0197                   CALL MNC_CW_ADD_GNAME(name, ndim, 
                0198      &                 dim, dn, ib, ie, myThid)
                0199                 ENDIF
                0200 
                0201               ENDDO
                0202             ENDDO
                0203 
                0204  10         CONTINUE
                0205           ENDDO
                0206         ENDDO
                0207       ENDDO
                0208 
f9c065a827 Ed H*0209 C     Define a "fizhi_veg" type to be used in FIZHI_INIT_VEG()
                0210 C
                0211 C     name           1234567890
                0212       ndim = 3
                0213       dn(1)(1:10) = 'X         '
                0214       dim(1)      = sNx + 2*OLx
                0215       ib(1)       = OLx + 1
                0216       ie(1)       = OLx + sNx
                0217       dn(2)(1:10) = 'Y         '
                0218       dim(2)      = sNy + 2*OLy
                0219       ib(2)       = OLy + 1
                0220       ie(2)       = OLy + sNy
                0221       dn(3)(1:10) = 'VegType   '
                0222       dim(3)      = maxtyp
                0223       ib(3)       = 1
                0224       ie(3)       = maxtyp
                0225 
                0226       CALL MNC_CW_ADD_GNAME('fizhi_veg', ndim, dim, dn,ib,ie, myThid)
                0227       CALL MNC_CW_ADD_VNAME('surftype', 'fizhi_veg', 4,5, myThid)
                0228       CALL MNC_CW_ADD_VNAME('tilefrac', 'fizhi_veg', 4,5, myThid)
                0229       
4ef02e4efb Ed H*0230 C     Used for the pickups
                0231       CALL MNC_CW_ADD_VNAME('uphy', 'U_xy_Hn__Zph__-'  ,4,5,myThid)
                0232       CALL MNC_CW_ADD_VNAME('vphy', 'V_xy_Hn__Zph__-'  ,4,5,myThid)
                0233       CALL MNC_CW_ADD_VNAME('thphy','Cen_xy_Hn__Zph__-',4,5,myThid)
                0234       CALL MNC_CW_ADD_VNAME('sphy', 'Cen_xy_Hn__Zph__-',4,5,myThid)
                0235 
                0236 C     For the veg IO
                0237 C     name           1234567890
                0238       ndim = 1
                0239       dn(1)(1:10) = 'chips     '
                0240       dim(1)      = nchp
                0241       ib(1)       = 1
                0242       ie(1)       = nchp
                0243       CALL MNC_CW_ADD_GNAME('fizhi_chip', ndim, dim, dn,ib,ie, myThid)
                0244       CALL MNC_CW_ADD_VNAME('ctmt', 'fizhi_chip', 2,3, myThid)
                0245       CALL MNC_CW_ADD_VNAME('xxmt', 'fizhi_chip', 2,3, myThid)
                0246       CALL MNC_CW_ADD_VNAME('yymt', 'fizhi_chip', 2,3, myThid)
                0247       CALL MNC_CW_ADD_VNAME('zetamt', 'fizhi_chip', 2,3, myThid)
                0248       CALL MNC_CW_ADD_VNAME('tcanopy', 'fizhi_chip', 2,3, myThid)
                0249       CALL MNC_CW_ADD_VNAME('tdeep', 'fizhi_chip', 2,3, myThid)
                0250       CALL MNC_CW_ADD_VNAME('ecanopy', 'fizhi_chip', 2,3, myThid)
                0251       CALL MNC_CW_ADD_VNAME('swetshal', 'fizhi_chip', 2,3, myThid)
                0252       CALL MNC_CW_ADD_VNAME('swetroot', 'fizhi_chip', 2,3, myThid)
                0253       CALL MNC_CW_ADD_VNAME('swetdeep', 'fizhi_chip', 2,3, myThid)
                0254       CALL MNC_CW_ADD_VNAME('snodep', 'fizhi_chip', 2,3, myThid)
                0255       CALL MNC_CW_ADD_VNAME('capac', 'fizhi_chip', 2,3, myThid)
                0256       CALL MNC_CW_ADD_VNAME('chlt', 'fizhi_chip', 2,3, myThid)
                0257       CALL MNC_CW_ADD_VNAME('chlon', 'fizhi_chip', 2,3, myThid)
                0258       CALL MNC_CW_ADD_VNAME('igrd', 'fizhi_chip', 2,3, myThid)
                0259       CALL MNC_CW_ADD_VNAME('ityp', 'fizhi_chip', 2,3, myThid)
                0260       CALL MNC_CW_ADD_VNAME('chfr', 'fizhi_chip', 2,3, myThid)
                0261 
                0262 C     name           1234567890
                0263       ndim = 2
                0264       dn(1)(1:10) = 'chips     '
                0265       dim(1)      = nchp
                0266       ib(1)       = 1
                0267       ie(1)       = nchp
                0268       dn(2)(1:10) = 'Zph       '
                0269       dim(2)      = NrPhys
                0270       ib(2)       = 1
                0271       ie(2)       = NrPhys
                0272       CALL MNC_CW_ADD_GNAME('fizhi_chiplev',ndim,dim,dn,ib,ie,myThid)
                0273       CALL MNC_CW_ADD_VNAME('xlmt', 'fizhi_chiplev', 3,4, myThid)
                0274       CALL MNC_CW_ADD_VNAME('khmt', 'fizhi_chiplev', 3,4, myThid)
                0275       CALL MNC_CW_ADD_VNAME('tke', 'fizhi_chiplev', 3,4, myThid)
f9c065a827 Ed H*0276 
580dd6560d Ed H*0277       ENDIF
                0278 
c83e0242d5 Ed H*0279 #endif  /*  ALLOW_MNC  */
                0280       
                0281       RETURN
                0282       END
                0283 
                0284 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
[ 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!