MITgcm |
|
|
|
|||
File indexing completed on 2018-03-02 18:45:24 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC7ae8fb32b5 Andr*0001 #include "FIZHI_OPTIONS.h" 0002 subroutine update_ocean_exports (myTime, myIter, myThid) 0003 c---------------------------------------------------------------------- 0004 c Subroutine update_ocean_exports - 'Wrapper' routine to update 88f72205aa Jean*0005 c the fields related to the ocean surface that are needed 7ae8fb32b5 Andr*0006 c by fizhi (sst and sea ice extent). 0007 c 0008 c Call: getsst (Return the current sst field-read dataset if needed) 0009 c getsice (Return the current sea ice field-read data if needed) 0010 c----------------------------------------------------------------------- 0011 implicit none 0012 #include "SIZE.h" 0013 #include "GRID.h" 0014 #include "fizhi_ocean_coms.h" 0015 #include "EEPARAMS.h" 0016 #include "chronos.h" 0017 #ifdef ALLOW_EXCH2 0adbb390e0 Jean*0018 #include "W2_EXCH2_SIZE.h" 7ae8fb32b5 Andr*0019 #include "W2_EXCH2_TOPOLOGY.h" 0020 #endif /* ALLOW_EXCH2 */ 0021 0022 integer myIter, myThid 0023 _RL myTime 0024 ff726dc601 Jean*0025 INTEGER xySize 0026 #if defined(ALLOW_EXCH2) 0027 PARAMETER ( xySize = W2_ioBufferSize ) 0028 #else 0029 PARAMETER ( xySize = Nx*Ny ) 0030 #endif 7ae8fb32b5 Andr*0031 integer i, j, bi, bj, bislot, bjslot 0032 integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2 0033 integer xsize, ysize 3215907427 Jean*0034 _RL sstmin 7ae8fb32b5 Andr*0035 parameter ( sstmin = 273.16 ) 0036 ff726dc601 Jean*0037 _RL sst1 (xySize), sst2 (xySize) 0038 _RL sice1(xySize), sice2(xySize) 0039 c _RL sst1(xsize,ysize),sst2(xsize,ysize) 0040 c _RL sice1(xsize,ysize),sice2(xsize,ysize) 7ae8fb32b5 Andr*0041 integer nymd1sst(nSx,nSy),nymd2sst(nSx,nSy) 0042 integer nymd1sice(nSx,nSy),nymd2sice(nSx,nSy) 0043 integer nhms1sst(nSx,nSy),nhms2sst(nSx,nSy) 0044 integer nhms1sice(nSx,nSy),nhms2sice(nSx,nSy) 0045 integer sstdates(370,nSx,nSy),sicedates(370,nSx,nSy) 0046 integer ssttimes(370,nSx,nSy),sicetimes(370,nSx,nSy) 0047 logical first(nSx,nSy) 0048 integer nSxnSy 0049 parameter(nSxnSy = nSx*nSy) 0050 data first/nSxnSy*.true./ 0051 0052 save nymd1sst,nymd2sst,nymd1sice,nymd2sice 0053 save nhms1sst,nhms2sst,nhms1sice,nhms2sice 0054 save sst1, sst2, sice1, sice2 0055 save sstdates, sicedates 0056 save ssttimes, sicetimes 0057 ff726dc601 Jean*0058 #if defined(ALLOW_EXCH2) 0059 xsize = exch2_global_Nx 0060 ysize = exch2_global_Ny 0061 #else 0062 xsize = Nx 0063 ysize = Ny 0064 #endif 7ae8fb32b5 Andr*0065 idim1 = 1-OLx 0066 idim2 = sNx+OLx 0067 jdim1 = 1-OLy 0068 jdim2 = sNy+OLy 0069 im1 = 1 0070 im2 = sNx 0071 jm1 = 1 0072 jm2 = sNy 0073 0074 C*********************************************************************** 0075 0076 DO BJ = myByLo(myThid),myByHi(myThid) 0077 DO BI = myBxLo(myThid),myBxHi(myThid) 0078 #if defined(ALLOW_EXCH2) c424ee7cc7 Jean*0079 bislot = exch2_txglobalo(W2_myTileList(bi,bj))-1 0080 bjslot = exch2_tyglobalo(W2_myTileList(bi,bj))-1 7ae8fb32b5 Andr*0081 #else 0082 bislot = myXGlobalLo-1+(bi-1)*sNx 0083 bjslot = myYGlobalLo-1+(bj-1)*sNy 0084 #endif 0085 a968dd4cbf Andr*0086 call getsst(ksst,sstclim,idim1,idim2,jdim1,jdim2,im1,im2, 0087 . jm1,jm2,nSx,nSy,xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms, 0088 . sst1,sst2,first(bi,bj),nymd1sst(bi,bj),nymd2sst(bi,bj), 7ae8fb32b5 Andr*0089 . nhms1sst(bi,bj),nhms2sst(bi,bj),sstdates(1,bi,bj), 0090 . ssttimes(1,bi,bj),sst,myThid) a968dd4cbf Andr*0091 call getsice(kice,siceclim,idim1,idim2,jdim1,jdim2,im1,im2, 0092 . jm1,jm2,nSx,nSy,xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms, 0093 . sice1,sice2,first(bi,bj),nymd1sice(bi,bj),nymd2sice(bi,bj), 7ae8fb32b5 Andr*0094 . nhms1sice(bi,bj),nhms2sice(bi,bj),sicedates(1,bi,bj), 0095 . sicetimes(1,bi,bj),sice,myThid) 0096 0097 c Check for Minimum Open-Water SST 0098 c -------------------------------- 0099 do j=jm1,jm2 0100 do i=im1,im2 0101 if(sice(i,j,bi,bj).eq.0.0 .and. sst(i,j,bi,bj).lt.sstmin) 0102 . sst(i,j,bi,bj) = sstmin 0103 enddo 0104 enddo 0105 0106 ENDDO 0107 ENDDO 12ffad7671 Jean*0108 _EXCH_XY_RL(sst,myThid) 0109 _EXCH_XY_RL(sice,myThid) 7ae8fb32b5 Andr*0110 0111 return 0112 end 0113 a968dd4cbf Andr*0114 subroutine getsice(iunit,clim,idim1,idim2,jdim1,jdim2,im1,im2, 0115 . jm1,jm2,nSumx,nSumy,xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms, 0116 . sicebc1,sicebc2,first,nymdbc1,nymdbc2,nhmsbc1,nhmsbc2, 0117 . nymdbc,nhmsbc,sice,mythid) 7ae8fb32b5 Andr*0118 C*********************************************************************** 0119 C ff726dc601 Jean*0120 C!ROUTINE: GETSICE 0121 C!DESCRIPTION: GETSICE returns the sea ice depth. 0122 C! This routine is adaptable for any frequency 0123 C! data upto a daily frequency. 0124 C! note: for diurnal data ndmax should be increased. 7ae8fb32b5 Andr*0125 C 0126 C!INPUT PARAMETERS: ff726dc601 Jean*0127 C! iunit Unit number assigned to the sice data file 7ae8fb32b5 Andr*0128 C! idim1 Start dimension in x-direction 0129 C! idim2 End dimension in x-direction 0130 C! jdim1 Start dimension in y-direction 0131 C! jdim2 End dimension in y-direction 0132 C! im1 Begin of x-direction span for filling sice 0133 C! im2 End of x-direction span for filling sice 0134 C! jm1 Begin of y-direction span for filling sice 0135 C! jm2 End of y-direction span for filling sice 0136 C! nSumx Number of processors in x-direction (local processor) 0137 C! nSumy Number of processors in y-direction (local processor) 0138 C! xsize Number of processors in x-direction (global) 0139 C! ysize Number of processors in y-direction (global) 0140 C! bi Processor number in x-direction (local to processor) 0141 C! bj Processor number in y-direction (local to processor) 0142 C! bislot Processor number in x-direction (global) 0143 C! bjslot Processor number in y-direction (global) ff726dc601 Jean*0144 C! nymd YYMMDD of the current model timestep 0145 C! nhms HHMMSS of the model time 7ae8fb32b5 Andr*0146 C 0147 C!OUTPUT PARAMETERS: ff726dc601 Jean*0148 C! sice(idim1:idim2,jdim1:jdim2,nSumx,nSumy) Sea ice depth in meters 7ae8fb32b5 Andr*0149 C 0150 C!ROUTINES CALLED: 0151 C ff726dc601 Jean*0152 C! bcdata Reads the data for a given unit number 0153 C! bcheader Reads the header info for a given unit number 7ae8fb32b5 Andr*0154 C! interp_time Returns weights for linear interpolation 0155 C 0156 C-------------------------------------------------------------------------- 0157 0158 implicit none 0159 #include "SIZE.h" 0160 #include "GRID.h" 0161 0162 integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy 0163 integer xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms,mythid 0164 0165 _RL sicebc1(xsize,ysize) 0166 _RL sicebc2(xsize,ysize) 0167 _RL sice(idim1:idim2,jdim1:jdim2,nSumx,nSumy) 0168 integer nhmsbc1,nhmsbc2,nymdbc1,nymdbc2 0169 logical first a968dd4cbf Andr*0170 logical clim 7ae8fb32b5 Andr*0171 0172 C Maximum number of dates in one year for the data 0173 integer ndmax 0174 parameter (ndmax = 370) 0175 integer nymdbc(ndmax),nhmsbc(ndmax) 0176 0177 integer i,j 3215907427 Jean*0178 7ae8fb32b5 Andr*0179 do j = jm1,jm2 0180 do i = im1,im2 0181 sice(i,j,bi,bj) = 0. 0182 enddo 0183 enddo 0184 0185 return 0186 end a968dd4cbf Andr*0187 subroutine getsst(iunit,clim,idim1,idim2,jdim1,jdim2,im1,im2, 0188 . jm1,jm2,nSumx,nSumy,xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms, 0189 . sstbc1,sstbc2,first,nymdbc1,nymdbc2,nhmsbc1,nhmsbc2, 0190 . nymdbc,nhmsbc,sst,mythid) 7ae8fb32b5 Andr*0191 C*********************************************************************** 0192 C ff726dc601 Jean*0193 C!ROUTINE: GETSST 0194 C!DESCRIPTION: GETSST gets the SST data. 0195 C! This routine is adaptable for any frequency 0196 C! data upto a daily frequency. 0197 C! note: for diurnal data ndmax should be increased. 7ae8fb32b5 Andr*0198 C 0199 C!INPUT PARAMETERS: ff726dc601 Jean*0200 C! iunit Unit number assigned to the sice data file 7ae8fb32b5 Andr*0201 C! idim1 Start dimension in x-direction 0202 C! idim2 End dimension in x-direction 0203 C! jdim1 Start dimension in y-direction 0204 C! jdim2 End dimension in y-direction 0205 C! im1 Begin of x-direction span for filling sst 0206 C! im2 End of x-direction span for filling sst 0207 C! jm1 Begin of y-direction span for filling sst 0208 C! jm2 End of y-direction span for filling sst 0209 C! nSumx Number of processors in x-direction (local processor) 0210 C! nSumy Number of processors in y-direction (local processor) 0211 C! xsize x-dimension of global array 0212 C! ysize y-dimension of global array 0213 C! bi Processor number in x-direction (local to processor) 0214 C! bj Processor number in y-direction (local to processor) 0215 C! bislot Slot number into global array in x-direction (global) 0216 C! bjslot Slot number into global array in y-direction (global) ff726dc601 Jean*0217 C! nymd YYMMDD of the current model timestep 0218 C! nhms HHMMSS of the model time 7ae8fb32b5 Andr*0219 C 0220 C!OUTPUT PARAMETERS: ff726dc601 Jean*0221 C! sst(idim1:idim2,jdim1:jdim2,nSumx,nSumy) Sea surface temperature (K) 7ae8fb32b5 Andr*0222 C 0223 C!ROUTINES CALLED: 0224 C ff726dc601 Jean*0225 C! bcdata Reads the data for a given unit number 0226 C! bcheader Reads the header info for a given unit number 7ae8fb32b5 Andr*0227 C! interp_time Returns weights for linear interpolation 0228 C 0229 C-------------------------------------------------------------------------- 0230 0231 implicit none 0232 #include "SIZE.h" 0233 #include "GRID.h" 0234 0235 integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy 0236 integer xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms,mythid 0237 0238 _RL sstbc1(xsize,ysize) 0239 _RL sstbc2(xsize,ysize) 0240 _RL sst(idim1:idim2,jdim1:jdim2,nSumx,nSumy) 0241 integer nhmsbc1,nhmsbc2,nymdbc1,nymdbc2 0242 logical first a968dd4cbf Andr*0243 logical clim 7ae8fb32b5 Andr*0244 0245 C Maximum number of dates in one year for the data 0246 integer ndmax 0247 parameter (ndmax = 370) 0248 integer nymdbc(ndmax),nhmsbc(ndmax) 0249 3215907427 Jean*0250 _RL getcon 0251 _RL pi,pio2,pio3,mpio3,pio36,deg2rad,sinarg 0252 c _RL factor,cosarg1,cosarg2 7ae8fb32b5 Andr*0253 0254 integer i,j 0255 0256 deg2rad = getcon('DEG2RAD') 0257 pi = getcon('PI') 0258 pio2 = pi / 2. _d 0 0259 pio3 = pi / 3. _d 0 0260 pio36 = pi / 36. _d 0 0261 mpio3 = -1. _d 0 * pi / 3. _d 0 0262 0263 do j = jm1,jm2 0264 do i = im1,im2 0265 C Control - max sst on equator, zonally symmetric 0266 if( abs(yc(i,j,bi,bj)*deg2rad) .lt. pio3 ) then 0267 sinarg = 3.*yc(i,j,bi,bj)*deg2rad/2. 0268 sst(i,j,bi,bj) = 273.16 + 27.*(1.-(sin(sinarg)*sin(sinarg))) 0269 else 0270 sst(i,j,bi,bj) = 273.16 0271 endif 0272 C Experiment 2 - Peaked 0273 C if( abs(yc(i,j,bi,bj)*deg2rad) .lt. pio3 ) then 0274 C factor = 3.*abs(yc(i,j,bi,bj))*deg2rad/pi 0275 C sst(i,j,bi,bj) = 273.16 + 27.*(1.-factor) 0276 C else 0277 C sst(i,j,bi,bj) = 273.16 0278 C endif 0279 C Experiment 3 - Flat 0280 C if( abs(yc(i,j,bi,bj)*deg2rad) .lt. pio3 ) then 0281 C sinarg = 3.*yc(i,j,bi,bj)*deg2rad/2. 3215907427 Jean*0282 C sst(i,j,bi,bj) = 273.16 + 7ae8fb32b5 Andr*0283 C . 27.*(1.-(sin(sinarg)*sin(sinarg)*sin(sinarg)*sin(sinarg))) 0284 C else 0285 C sst(i,j,bi,bj) = 273.16 0286 C endif 0287 C Experiment 4 - Qobs - average of control and exp 3 0288 C if( abs(yc(i,j,bi,bj)*deg2rad) .lt. pio3 ) then 0289 C sinarg = 3.*yc(i,j,bi,bj)*deg2rad/2. 0290 C sst(i,j,bi,bj) = 273.16 + 0.5*27* 3215907427 Jean*0291 C . (2.- (sin(sinarg)*sin(sinarg)) - 7ae8fb32b5 Andr*0292 C . (sin(sinarg)*sin(sinarg)*sin(sinarg)*sin(sinarg))) 0293 C else 0294 C sst(i,j,bi,bj) = 273.16 0295 C endif 0296 C Experiment 5 - max sst at 5N, zonally symmetric 0297 C if( (yc(i,j,bi,bj)*deg2rad .lt. pio3 ) .and. 0298 C . (yc(i,j,bi,bj)*deg2rad .gt. pio36 ) ) then 0299 C sinarg = (90./55.)*(yc(i,j,bi,bj)*deg2rad-pio36) 0300 C sst(i,j,bi,bj) = 273.16 + 27.*(1.-(sin(sinarg)*sin(sinarg))) 0301 C elseif ( (yc(i,j,bi,bj)*deg2rad .le. pio36 ) .and. 0302 C . (yc(i,j,bi,bj)*deg2rad .gt. mpio3 ) ) then 0303 C sinarg = (90./65.)*(yc(i,j,bi,bj)*deg2rad-pio36) 0304 C sst(i,j,bi,bj) = 273.16 + 27.*(1.-(sin(sinarg)*sin(sinarg))) 0305 C else 0306 C sst(i,j,bi,bj) = 273.16 0307 C endif 0308 C Experiment 6 - 1KEQ max sst at equator, + anomaly centered at greenwich 0309 C first set the control sst profile 0310 C if( abs(yc(i,j,bi,bj)*deg2rad) .lt. pio3 ) then 0311 C sinarg = 3.*yc(i,j,bi,bj)*deg2rad/2. 0312 C sst(i,j,bi,bj) = 273.16 + 27.*(1.-(sin(sinarg)*sin(sinarg))) 0313 C else 0314 C sst(i,j,bi,bj) = 273.16 0315 C endif 0316 C and now add the anomaly 0317 C if( (abs(yc(i,j,bi,bj)) .lt. 15. _d 0) .and. 0318 C . (abs(xc(i,j,bi,bj)) .lt. 30. _d 0) ) then 0319 C cosarg1 = pio2*(xc(i,j,bi,bj)/30. _d 0) 0320 C cosarg2 = pio2*(yc(i,j,bi,bj)/15. _d 0) 0321 C sst(i,j,bi,bj) = sst(i,j,bi,bj) + 0322 C . cos(cosarg1)*cos(cosarg1)*cos(cosarg2)*cos(cosarg2) 0323 C endif 0324 C Experiment 7 - 3KEQ max sst at equator, + anomaly centered at greenwich 0325 C first set the control sst profile 0326 C if( abs(yc(i,j,bi,bj)*deg2rad) .lt. pio3 ) then 0327 C sinarg = 3.*yc(i,j,bi,bj)*deg2rad/2. 0328 C sst(i,j,bi,bj) = 273.16 + 27.*(1.-(sin(sinarg)*sin(sinarg))) 0329 C else 0330 C sst(i,j,bi,bj) = 273.16 0331 C endif 0332 C and now add the anomaly 0333 C if( (abs(yc(i,j,bi,bj)) .lt. 15. _d 0) .and. 0334 C . (abs(xc(i,j,bi,bj)) .lt. 30. _d 0) ) then 0335 C cosarg1 = pio2*(xc(i,j,bi,bj)/30. _d 0) 0336 C cosarg2 = pio2*(yc(i,j,bi,bj)/15. _d 0) 0337 C sst(i,j,bi,bj) = sst(i,j,bi,bj) + 0338 C . 3.*cos(cosarg1)*cos(cosarg1)*cos(cosarg2)*cos(cosarg2) 0339 C endif 0340 C Experiment 8 - 3KW1 max sst at equator, +/- anomaly centered at greenwich 0341 C first set the control sst profile 0342 C if( abs(yc(i,j,bi,bj)*deg2rad) .lt. pio3 ) then 0343 C sinarg = 3.*yc(i,j,bi,bj)*deg2rad/2. 0344 C sst(i,j,bi,bj) = 273.16 + 27.*(1.-(sin(sinarg)*sin(sinarg))) 0345 C else 0346 C sst(i,j,bi,bj) = 273.16 0347 C endif 0348 C and now add the anomaly 0349 C if( abs(yc(i,j,bi,bj)) .lt. 30.0 _d 0 ) then 0350 C cosarg1 = (xc(i,j,bi,bj))*deg2rad 0351 C cosarg2 = pio2*(yc(i,j,bi,bj)/30.0 _d 0) 0352 C sst(i,j,bi,bj) = sst(i,j,bi,bj) + 0353 C . 3.*cos(cosarg1)*cos(cosarg2)*cos(cosarg2) 0354 C endif 0355 enddo 0356 enddo 0357 0358 return 0359 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 |
|