- Timestamp:
- 2010-12-05T12:53:44+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r2450 r2452 1168 1168 1169 1169 SUBROUTINE gls_rst( kt, cdrw ) 1170 !!--------------------------------------------------------------------- 1171 !! *** ROUTINE ts_rst *** 1172 !! 1173 !! ** Purpose : Read or write TKE file (en) in restart file 1174 !! 1175 !! ** Method : use of IOM library 1176 !! if the restart does not contain TKE, en is either 1177 !! set to rn_emin or recomputed (nn_igls/=0) 1178 !!---------------------------------------------------------------------- 1179 INTEGER , INTENT(in) :: kt ! ocean time-step 1180 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 1181 ! 1182 INTEGER :: jit, jk ! dummy loop indices 1183 INTEGER :: id1, id2, id3, id4, id5, id6, id7, id8 1184 INTEGER :: ji, jj, ikbu, ikbv, ikbum1, ikbvm1 1185 REAL(wp):: cbx, cby 1186 !!---------------------------------------------------------------------- 1187 ! 1188 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 1189 ! ! --------------- 1190 IF( ln_rstart ) THEN !* Read the restart file 1191 id1 = iom_varid( numror, 'en' , ldstop = .FALSE. ) 1192 id2 = iom_varid( numror, 'avt' , ldstop = .FALSE. ) 1193 id3 = iom_varid( numror, 'avm' , ldstop = .FALSE. ) 1194 id4 = iom_varid( numror, 'avmu' , ldstop = .FALSE. ) 1195 id5 = iom_varid( numror, 'avmv' , ldstop = .FALSE. ) 1196 id6 = iom_varid( numror, 'mxln' , ldstop = .FALSE. ) 1197 id7 = iom_varid( numror, 'wbotu', ldstop = .FALSE. ) 1198 id8 = iom_varid( numror, 'wbotv', ldstop = .FALSE. ) 1199 ! 1200 IF( MIN( id1, id2, id3, id4, id5, id6, id7, id8 ) > 0 ) THEN ! all required arrays exist 1201 CALL iom_get( numror, jpdom_autoglo, 'en' , en ) 1202 CALL iom_get( numror, jpdom_autoglo, 'avt' , avt ) 1203 CALL iom_get( numror, jpdom_autoglo, 'avm' , avm ) 1204 CALL iom_get( numror, jpdom_autoglo, 'avmu' , avmu ) 1205 CALL iom_get( numror, jpdom_autoglo, 'avmv' , avmv ) 1206 CALL iom_get( numror, jpdom_autoglo, 'mxln' , mxln ) 1207 CALL iom_get( numror, jpdom_autoglo, 'wbotu' , wbotu ) 1208 CALL iom_get( numror, jpdom_autoglo, 'wbotv' , wbotv ) 1209 ELSE 1210 IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without gls scheme, en and mxln computed by iterative loop' 1211 IF(lwp) WRITE(numout,*) ' ===>>>> : The bottom stresses are estimated' 1212 en (:,:,:) = rn_emin 1213 mxln(:,:,:) = 0.001 1214 ! Initialize bottom stresses 1215 DO jj = 2, jpjm1 1216 DO ji = fs_2, fs_jpim1 ! vector opt. 1217 ikbu = mbku(ji,jj) + 1 ! k bottom level of uw-point 1218 ikbum1 = mbku(ji,jj) ! k-1 bottom level of u -point, but >=1 1219 ikbv = mbkv(ji,jj) + 1 1220 ikbvm1 = mbkv(ji,jj) 1221 cbx = avmu(ji,jj,ikbu) / fse3uw(ji,jj,ikbu) 1222 cby = avmv(ji,jj,ikbv) / fse3vw(ji,jj,ikbv) 1223 wbotu(ji,jj) = -cbx * un(ji,jj,ikbum1) * umask(ji,jj,1) 1224 wbotv(ji,jj) = -cby * vn(ji,jj,ikbvm1) * vmask(ji,jj,1) 1225 END DO 1226 END DO 1227 DO jit = nit000 + 1, nit000 + 10 ; CALL zdf_gls( jit ) ; END DO 1228 ENDIF 1229 ELSE !* Start from rest 1230 IF(lwp) WRITE(numout,*) ' ===>>>> : Initialisation of en and mxln by background values' 1231 IF(lwp) WRITE(numout,*) ' ===>>>> : The bottom stresses are estimated' 1232 en (:,:,:) = rn_emin 1233 mxln(:,:,:) = 0.001 1234 ! Initialize bottom stresses 1235 DO jj = 2, jpjm1 1236 DO ji = fs_2, fs_jpim1 ! vector opt. 1237 ikbu = mbku(ji,jj) + 1 ! k bottom level of uw-point 1238 ikbum1 = mbku(ji,jj) ! k-1 bottom level of u -point, but >=1 1239 ikbv = mbkv(ji,jj) + 1 1240 ikbvm1 = mbkv(ji,jj) 1241 cbx = avmu(ji,jj,ikbu) / fse3uw(ji,jj,ikbu) 1242 cby = avmv(ji,jj,ikbv) / fse3vw(ji,jj,ikbv) 1243 wbotu(ji,jj) = -cbx * un(ji,jj,ikbum1) * umask(ji,jj,1) 1244 wbotv(ji,jj) = -cby * vn(ji,jj,ikbvm1) * vmask(ji,jj,1) 1245 END DO 1246 END DO 1247 ENDIF 1248 ! 1249 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 1250 ! ! ------------------- 1251 IF(lwp) WRITE(numout,*) '---- gls-rst ----' 1252 CALL iom_rstput( kt, nitrst, numrow, 'en' , en ) 1253 CALL iom_rstput( kt, nitrst, numrow, 'avt' , avt ) 1254 CALL iom_rstput( kt, nitrst, numrow, 'avm' , avm ) 1255 CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu ) 1256 CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv ) 1257 CALL iom_rstput( kt, nitrst, numrow, 'mxln' , mxln ) 1258 ! 1259 ENDIF 1260 ! 1170 !!--------------------------------------------------------------------- 1171 !! *** ROUTINE ts_rst *** 1172 !! 1173 !! ** Purpose : Read or write TKE file (en) in restart file 1174 !! 1175 !! ** Method : use of IOM library 1176 !! if the restart does not contain TKE, en is either 1177 !! set to rn_emin or recomputed (nn_igls/=0) 1178 !!---------------------------------------------------------------------- 1179 INTEGER , INTENT(in) :: kt ! ocean time-step 1180 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 1181 ! 1182 INTEGER :: jit, jk ! dummy loop indices 1183 INTEGER :: id1, id2, id3, id4, id5, id6, id7, id8 1184 INTEGER :: ji, jj, ikbu, ikbv 1185 REAL(wp):: cbx, cby 1186 !!---------------------------------------------------------------------- 1187 ! 1188 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 1189 ! ! --------------- 1190 IF( ln_rstart ) THEN !* Read the restart file 1191 id1 = iom_varid( numror, 'en' , ldstop = .FALSE. ) 1192 id2 = iom_varid( numror, 'avt' , ldstop = .FALSE. ) 1193 id3 = iom_varid( numror, 'avm' , ldstop = .FALSE. ) 1194 id4 = iom_varid( numror, 'avmu' , ldstop = .FALSE. ) 1195 id5 = iom_varid( numror, 'avmv' , ldstop = .FALSE. ) 1196 id6 = iom_varid( numror, 'mxln' , ldstop = .FALSE. ) 1197 id7 = iom_varid( numror, 'wbotu', ldstop = .FALSE. ) 1198 id8 = iom_varid( numror, 'wbotv', ldstop = .FALSE. ) 1199 ! 1200 IF( MIN( id1, id2, id3, id4, id5, id6, id7, id8 ) > 0 ) THEN ! all required arrays exist 1201 CALL iom_get( numror, jpdom_autoglo, 'en' , en ) 1202 CALL iom_get( numror, jpdom_autoglo, 'avt' , avt ) 1203 CALL iom_get( numror, jpdom_autoglo, 'avm' , avm ) 1204 CALL iom_get( numror, jpdom_autoglo, 'avmu' , avmu ) 1205 CALL iom_get( numror, jpdom_autoglo, 'avmv' , avmv ) 1206 CALL iom_get( numror, jpdom_autoglo, 'mxln' , mxln ) 1207 CALL iom_get( numror, jpdom_autoglo, 'wbotu' , wbotu ) 1208 CALL iom_get( numror, jpdom_autoglo, 'wbotv' , wbotv ) 1209 ELSE 1210 IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without gls scheme, en and mxln computed by iterative loop' 1211 IF(lwp) WRITE(numout,*) ' ===>>>> : The bottom stresses are estimated' 1212 en (:,:,:) = rn_emin 1213 mxln(:,:,:) = 0.001 1214 ! Initialize bottom stresses 1215 DO jj = 2, jpjm1 1216 DO ji = fs_2, fs_jpim1 ! vector opt. 1217 ikbu = mbku(ji,jj) ! bottom ocean level of u-point 1218 ikbv = mbkv(ji,jj) 1219 cbx = avmu(ji,jj,ikbu+1) / fse3uw(ji,jj,ikbu+1) 1220 cby = avmv(ji,jj,ikbv+1) / fse3vw(ji,jj,ikbv+1) 1221 wbotu(ji,jj) = -cbx * un(ji,jj,ikbu) * umask(ji,jj,1) 1222 wbotv(ji,jj) = -cby * vn(ji,jj,ikbv) * vmask(ji,jj,1) 1223 END DO 1224 END DO 1225 DO jit = nit000 + 1, nit000 + 10 ; CALL zdf_gls( jit ) ; END DO 1226 ENDIF 1227 ELSE !* Start from rest 1228 IF(lwp) WRITE(numout,*) ' ===>>>> : Initialisation of en and mxln by background values' 1229 IF(lwp) WRITE(numout,*) ' ===>>>> : The bottom stresses are estimated' 1230 en (:,:,:) = rn_emin 1231 mxln(:,:,:) = 0.001 1232 ! Initialize bottom stresses 1233 DO jj = 2, jpjm1 1234 DO ji = fs_2, fs_jpim1 ! vector opt. 1235 ikbu = mbku(ji,jj) ! bottom ocean level of u-point 1236 ikbv = mbkv(ji,jj) 1237 cbx = avmu(ji,jj,ikbu+1) / fse3uw(ji,jj,ikbu+1) 1238 cby = avmv(ji,jj,ikbv+1) / fse3vw(ji,jj,ikbv+1) 1239 wbotu(ji,jj) = -cbx * un(ji,jj,ikbu) * umask(ji,jj,1) 1240 wbotv(ji,jj) = -cby * vn(ji,jj,ikbv) * vmask(ji,jj,1) 1241 END DO 1242 END DO 1243 ENDIF 1244 ! 1245 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 1246 ! ! ------------------- 1247 IF(lwp) WRITE(numout,*) '---- gls-rst ----' 1248 CALL iom_rstput( kt, nitrst, numrow, 'en' , en ) 1249 CALL iom_rstput( kt, nitrst, numrow, 'avt' , avt ) 1250 CALL iom_rstput( kt, nitrst, numrow, 'avm' , avm ) 1251 CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu ) 1252 CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv ) 1253 CALL iom_rstput( kt, nitrst, numrow, 'mxln' , mxln ) 1254 CALL iom_rstput( kt, nitrst, numrow, 'wbotu' , wbotu ) 1255 CALL iom_rstput( kt, nitrst, numrow, 'wbotv' , wbotv ) 1256 ! 1257 ENDIF 1258 ! 1261 1259 END SUBROUTINE gls_rst 1262 1260
Note: See TracChangeset
for help on using the changeset viewer.
