** 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, 18 May 2024 05:11:33 GMT
Content-Type: text/html; charset=utf-8
MITgcm/MITgcm/pkg/fizhi/fizhi_init_fixed.F
File indexing completed on 2018-03-02 18:40:11 UTC
view on github raw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
a456aa407c Andr* 0001 #include "FIZHI_OPTIONS.h "
b59c0889bb Jean* 0002 SUBROUTINE FIZHI_INIT_FIXED (myThid )
e337e4ca8c Andr* 0003
0004
a6b4f97600 Jean* 0005
e337e4ca8c Andr* 0006
0007
a6b4f97600 Jean* 0008
e337e4ca8c Andr* 0009
0010
0011
0012
0013
0014
0015
0016
0017
328acc481c Andr* 0018
0019
e337e4ca8c Andr* 0020
b59c0889bb Jean* 0021 IMPLICIT NONE
e337e4ca8c Andr* 0022 #include "SIZE.h "
0023 #include "fizhi_SIZE.h "
f4a0368053 Andr* 0024 #include "fizhi_land_SIZE.h "
e337e4ca8c Andr* 0025 #include "EEPARAMS.h "
f4a0368053 Andr* 0026 #include "fizhi_chemistry_coms.h "
0027 #include "fizhi_earth_coms.h "
328acc481c Andr* 0028 #include "fizhi_land_coms.h "
d9ce6b5984 Andr* 0029 #include "fizhi_ocean_coms.h "
328acc481c Andr* 0030 #include "chronos.h "
6212a59f06 Andr* 0031 #include "gridalt_mapping.h "
dbae14396f Andr* 0032 #include "GRID.h "
9a6b9d7b6d Andr* 0033 #include "PARAMS.h "
f1edb8ebdb Andr* 0034 #ifdef ALLOW_EXCH2
f9f661930b Jean* 0035 #include "W2_EXCH2_SIZE.h "
f1edb8ebdb Andr* 0036 #include "W2_EXCH2_TOPOLOGY.h "
0037 #endif /* ALLOW_EXCH2 */
e337e4ca8c Andr* 0038
b59c0889bb Jean* 0039 INTEGER myThid
e337e4ca8c Andr* 0040
b59c0889bb Jean* 0041 INTEGER i ,j ,L ,bi ,bj
0042 INTEGER im1 , im2 , jm1 , jm2 , idim2 , jdim2
0043 INTEGER nymdb ,nhmsb
0044 CHARACTER *40 vegdata
3768927683 Andr* 0045 _RL pressure0 (Nrphys +1)
6212a59f06 Andr* 0046 _RL pressure (Nrphys )
b59c0889bb Jean* 0047 _RL lats (sNx ,sNy ,nSx ,nSy ), lons (sNx ,sNy ,nSx ,nSy )
0048 _RL fracland (sNx ,sNy ,nSx ,nSy )
0049 _RL tempoverlap (1-OLx :sNx +OLx ,1-OLy :sNy +OLy ,nSx ,nSy )
0050 INTEGER xsize , ysize
a6b4f97600 Jean* 0051
f1edb8ebdb Andr* 0052 #if defined(ALLOW_EXCH2 )
a6b4f97600 Jean* 0053 xsize = exch2_global_Nx
0054 ysize = exch2_global_Ny
f1edb8ebdb Andr* 0055 #else
a6b4f97600 Jean* 0056 xsize = Nx
0057 ysize = Ny
f1edb8ebdb Andr* 0058 #endif
d9ce6b5984 Andr* 0059 idim2 = sNx +OLx
0060 jdim2 = sNy +OLy
0061 im1 = 1
0062 im2 = sNx
0063 jm1 = 1
0064 jm2 = sNy
328acc481c Andr* 0065 nymdb = nymd0
0066 nhmsb = nhms0
e337e4ca8c Andr* 0067
84e6328399 Andr* 0068 #ifdef ALLOW_MNC
0069 if (useMNC ) then
0070 call fizhi_mnc_init (myThid )
0071 endif
0072 #endif
0073
5cbcb662ee Andr* 0074 #ifdef ALLOW_DIAGNOSTICS
67c5129214 Andr* 0075 if ( useDiagnostics ) then
5cbcb662ee Andr* 0076 call fizhi_diagnostics_init ( myThid )
67c5129214 Andr* 0077 endif
5cbcb662ee Andr* 0078 #endif
0079
328acc481c Andr* 0080 call fizhi_alarms (nymdb ,nhmsb ,deltaTClock )
dbae14396f Andr* 0081
0082 do bj = myByLo (myThid ), myByHi (myThid )
0083 do bi = myBxLo (myThid ), myBxHi (myThid )
4a7a870959 Andr* 0084 do j = jm1 ,jm2
0085 do i = im1 ,im2
dbae14396f Andr* 0086 lons (i ,j ,bi ,bj ) = xC (i ,j ,bi ,bj )
0087 lats (i ,j ,bi ,bj ) = yC (i ,j ,bi ,bj )
0088 enddo
0089 enddo
0090 enddo
0091 enddo
f1edb8ebdb Andr* 0092 if (xsize .eq. 192) then
0093 vegdata = 'veg19232.data'
0094 elseif (xsize .eq. 612) then
0095 vegdata = 'veg612102.data'
0096 else
0097 print *,' xsize is ' ,xsize
0098 stop 'do not seem to have correct vegetation data '
0099 endif
0100
b59c0889bb Jean* 0101 call fizhi_init_veg ( myThid , vegdata ,im2 ,jm2 ,nSx ,nSy ,
0102 & nSx *nPx ,nSy *nPy ,maxtyp ,nchp ,nchptot ,nchpland ,lons ,lats ,
0103 & surftype ,tilefrac ,igrd ,ityp ,chfr ,chlt ,chlon )
328acc481c Andr* 0104
d9ce6b5984 Andr* 0105
0106 do bj = myByLo (myThid ), myByHi (myThid )
0107 do bi = myBxLo (myThid ), myBxHi (myThid )
b59c0889bb Jean* 0108 call get_landfrac (im2 ,jm2 ,nSx ,nSy ,bi ,bj ,maxtyp ,
0109 & surftype ,tilefrac ,fracland (1,1,bi ,bj ))
d9ce6b5984 Andr* 0110 do j =jm1 ,jm2
0111 do i =im1 ,im2
0112 landtype (i ,j ,bi ,bj ) = surftype (i ,j ,1,bi ,bj )
9a6b9d7b6d Andr* 0113 if (fracland (i ,j ,bi ,bj ).ge. 0.3.and. surftype (i ,j ,1,bi ,bj ).ge. 100)
b59c0889bb Jean* 0114 & landtype (i ,j ,bi ,bj ) = surftype (i ,j ,2,bi ,bj )
d9ce6b5984 Andr* 0115 if (sice (i ,j ,bi ,bj ).ne. 0.0)landtype (i ,j ,bi ,bj ) = 101
0116 enddo
0117 enddo
0118 enddo
0119 enddo
0120
a6b4f97600 Jean* 0121
3768927683 Andr* 0122
328acc481c Andr* 0123
100e60ef4b Andr* 0124 pressure0 (1)=1000.
6212a59f06 Andr* 0125 do L = 2,Nrphys +1
100e60ef4b Andr* 0126 pressure0 (L )=pressure0 (L -1)-dpphys0 (1,1,L -1,1,1)/100.
0127 enddo
3768927683 Andr* 0128
0129
0130 do L = 1,Nrphys
0131 pressure (L )=(pressure0 (Nrphys +2-L )+pressure0 (Nrphys +1-L ))/2.
e337e4ca8c Andr* 0132 enddo
0133
b59c0889bb Jean* 0134 call fizhi_init_chem (myThid ,
0135 & nlatsoz ,nlevsoz ,ntimesoz ,latsoz ,levsoz ,ozone ,
0136 & nlatsq ,nlevsq ,ntimesq ,latsq ,levsq ,stratq ,
0137 & Nrphys ,pressure ,n2o ,methane ,co2 ,cfc11 ,cfc12 ,cfc22 )
328acc481c Andr* 0138
4b593e063b Andr* 0139
f1edb8ebdb Andr* 0140 if (xsize .eq. 192) then
b59c0889bb Jean* 0141 CALL READ_REC_XY_RL ('topvar19232.data' ,tempoverlap ,1,0,myThid )
f1edb8ebdb Andr* 0142 elseif (xsize .eq. 612) then
b59c0889bb Jean* 0143 CALL READ_REC_XY_RL ('topvar612102.data' ,tempoverlap ,1,0,myThid )
f1edb8ebdb Andr* 0144 else
0145 print *,' xsize is ' ,xsize
0146 stop 'do not seem to have correct topog variance data '
0147 endif
170ac911e1 Andr* 0148 _BARRIER
9524fe64b5 Andr* 0149
2cdbf240be Andr* 0150 do bj = myByLo (myThid ), myByHi (myThid )
0151 do bi = myBxLo (myThid ), myBxHi (myThid )
0152 do j =jm1 ,jm2
0153 do i =im1 ,im2
25c03646d6 Andr* 0154 if (fracland (i ,j ,bi ,bj ).gt. 0.3) then
0155 phis_var (i ,j ,bi ,bj ) = tempoverlap (i ,j ,bi ,bj )
0156 else
0157 phis_var (i ,j ,bi ,bj ) = 0.
0158 endif
2cdbf240be Andr* 0159 enddo
0160 enddo
0161 enddo
0162 enddo
0163
3f946231fb Andr* 0164
0165
0166
0167 call mdsfindunit ( kice , myThid )
0168 open (kice )
0169 call mdsfindunit ( ksst , myThid )
0170 open (ksst )
0171
e337e4ca8c Andr* 0172 return
0173 end