Changeset 3764 for branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/DOM
- Timestamp:
- 2013-01-23T15:33:04+01:00 (11 years ago)
- Location:
- branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/DOM
- Files:
-
- 4 edited
-
daymod.F90 (modified) (20 diffs)
-
domain.F90 (modified) (5 diffs)
-
domzgr.F90 (modified) (11 diffs)
-
istate.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
r3680 r3764 2 2 !!====================================================================== 3 3 !! *** MODULE daymod *** 4 !! Ocean : calendar 4 !! Ocean : calendar 5 5 !!===================================================================== 6 6 !! History : OPA ! 1994-09 (M. Pontaud M. Imbard) Original code 7 7 !! ! 1997-03 (O. Marti) 8 !! ! 1997-05 (G. Madec) 8 !! ! 1997-05 (G. Madec) 9 9 !! ! 1997-08 (M. Imbard) 10 10 !! NEMO 1.0 ! 2003-09 (G. Madec) F90 + nyear, nmonth, nday 11 11 !! ! 2004-01 (A.M. Treguier) new calculation based on adatrj 12 12 !! ! 2006-08 (G. Madec) surface module major update 13 !!---------------------------------------------------------------------- 13 !!---------------------------------------------------------------------- 14 14 15 15 !!---------------------------------------------------------------------- 16 16 !! day : calendar 17 !! 17 !! 18 18 !! ------------------------------- 19 19 !! ----------- WARNING ----------- … … 24 24 !! ----------- WARNING ----------- 25 25 !! ------------------------------- 26 !! 26 !! 27 27 !!---------------------------------------------------------------------- 28 28 USE dom_oce ! ocean space and time domain 29 29 USE phycst ! physical constants 30 30 USE in_out_manager ! I/O manager 31 USE iom ! 31 USE iom ! 32 32 USE ioipsl, ONLY : ymds2ju ! for calendar 33 33 USE prtctl ! Print control … … 41 41 PUBLIC day ! called by step.F90 42 42 PUBLIC day_init ! called by istate.F90 43 44 INTEGER :: nsecd, nsecd05, ndt, ndt05 43 PUBLIC day_mth ! Needed by TAM 44 45 INTEGER, PUBLIC :: nsecd, nsecd05, ndt, ndt05 ! (PUBLIC for TAM) 45 46 46 47 !!---------------------------------------------------------------------- … … 54 55 !!---------------------------------------------------------------------- 55 56 !! *** ROUTINE day_init *** 56 !! 57 !! ** Purpose : Initialization of the calendar values to their values 1 time step before nit000 57 !! 58 !! ** Purpose : Initialization of the calendar values to their values 1 time step before nit000 58 59 !! because day will be called at the beginning of step 59 60 !! … … 81 82 ndt05 = NINT(0.5 * rdttra(1)) 82 83 83 IF( .NOT. lk_offline ) CALL day_rst( nit000, 'READ' ) 84 IF( .NOT. lk_offline ) CALL day_rst( nit000, 'READ' ) 84 85 85 86 ! set the calandar from ndastp (read in restart file and namelist) … … 87 88 nyear = ndastp / 10000 88 89 nmonth = ( ndastp - (nyear * 10000) ) / 100 89 nday = ndastp - (nyear * 10000) - ( nmonth * 100 ) 90 nday = ndastp - (nyear * 10000) - ( nmonth * 100 ) 90 91 91 92 CALL ymds2ju( nyear, nmonth, nday, 0.0, fjulday ) ! we assume that we start run at 00:00 … … 95 96 nsec1jan000 = 0 96 97 CALL day_mth 97 98 98 99 IF ( nday == 0 ) THEN ! for ex if ndastp = ndate0 - 1 99 nmonth = nmonth - 1 100 nmonth = nmonth - 1 100 101 nday = nmonth_len(nmonth) 101 102 ENDIF … … 106 107 IF( nleapy == 1 ) CALL day_mth 107 108 ENDIF 108 109 109 110 ! day since january 1st 110 111 nday_year = nday + SUM( nmonth_len(1:nmonth - 1) ) 111 112 112 !compute number of days between last monday and today 113 !compute number of days between last monday and today 113 114 CALL ymds2ju( 1900, 01, 01, 0.0, zjul ) ! compute julian day value of 01.01.1900 (our reference that was a Monday) 114 inbday = NINT(fjulday - zjul) ! compute nb day between 01.01.1900 and current day 115 idweek = MOD(inbday, 7) ! compute nb day between last monday and current day 115 inbday = NINT(fjulday - zjul) ! compute nb day between 01.01.1900 and current day 116 idweek = MOD(inbday, 7) ! compute nb day between last monday and current day 116 117 117 118 ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step … … 135 136 !!---------------------------------------------------------------------- 136 137 !! *** ROUTINE day_init *** 137 !! 138 !! 138 139 !! ** Purpose : calendar values related to the months 139 140 !! … … 147 148 148 149 ! length of the month of the current year (from nleapy, read in namelist) 149 IF ( nleapy < 2 ) THEN 150 IF ( nleapy < 2 ) THEN 150 151 nmonth_len(:) = (/ 31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 /) 151 152 nyear_len(:) = 365 … … 167 168 ! time since Jan 1st 0 1 2 ... 11 12 13 168 169 ! ---------*--|--*--|--*--| ... |--*--|--*--|--*--|-------------------------------------- 169 ! <---> <---> <---> ... <---> <---> <---> 170 ! <---> <---> <---> ... <---> <---> <---> 170 171 ! month number 0 1 2 ... 11 12 13 171 172 ! … … 180 181 nmonth_end(jm) = nmonth_end(jm-1) + nsecd * nmonth_len(jm) 181 182 END DO 182 ! 183 END SUBROUTINE 183 ! 184 END SUBROUTINE 184 185 185 186 … … 187 188 !!---------------------------------------------------------------------- 188 189 !! *** ROUTINE day *** 189 !! 190 !! 190 191 !! ** Purpose : Compute the date with a day iteration IF necessary. 191 192 !! … … 199 200 !! - adatrj : date in days since the beginning of the run 200 201 !! - nsec_year : current time of the year (in second since 00h, jan 1st) 201 !!---------------------------------------------------------------------- 202 !!---------------------------------------------------------------------- 202 203 INTEGER, INTENT(in) :: kt ! ocean time-step indices 203 204 ! … … 210 211 zprec = 0.1 / rday 211 212 ! ! New time-step 212 nsec_year = nsec_year + ndt 213 nsec_month = nsec_month + ndt 213 nsec_year = nsec_year + ndt 214 nsec_month = nsec_month + ndt 214 215 nsec_week = nsec_week + ndt 215 nsec_day = nsec_day + ndt 216 nsec_day = nsec_day + ndt 216 217 adatrj = adatrj + rdttra(1) / rday 217 218 fjulday = fjulday + rdttra(1) / rday 218 219 IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec ) fjulday = REAL(NINT(fjulday),wp) ! avoid truncation error 219 220 IF( ABS(adatrj - REAL(NINT(adatrj ),wp)) < zprec ) adatrj = REAL(NINT(adatrj ),wp) ! avoid truncation error 220 221 221 222 IF( nsec_day > nsecd ) THEN ! New day 222 223 ! … … 251 252 252 253 IF( nsec_week > 7*nsecd ) nsec_week = ndt05 ! New week 253 254 254 255 IF(ln_ctl) THEN 255 256 WRITE(charout,FMT="('kt =', I4,' d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear … … 268 269 !!--------------------------------------------------------------------- 269 270 !! *** ROUTINE ts_rst *** 270 !! 271 !! 271 272 !! ** Purpose : Read or write calendar in restart file: 272 !! 273 !! 273 274 !! WRITE(READ) mode: 274 !! kt : number of time step since the begining of the experiment at the 275 !! kt : number of time step since the begining of the experiment at the 275 276 !! end of the current(previous) run 276 !! adatrj(0) : number of elapsed days since the begining of the experiment at the 277 !! adatrj(0) : number of elapsed days since the begining of the experiment at the 277 278 !! end of the current(previous) run (REAL -> keep fractions of day) 278 279 !! ndastp : date at the end of the current(previous) run (coded as yyyymmdd integer) 279 !! 280 !! 280 281 !! According to namelist parameter nrstdt, 281 282 !! nrstdt = 0 no control on the date (nit000 is arbitrary). … … 295 296 REAL(wp) :: zkt, zndastp 296 297 !!---------------------------------------------------------------------- 297 298 298 299 IF( TRIM(cdrw) == 'READ' ) THEN 299 300 … … 312 313 WRITE(numout,*) 313 314 ENDIF 314 ! Control of date 315 IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 ) & 316 & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 315 ! Control of date 316 IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 ) & 317 & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 317 318 & ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) 318 319 ! define ndastp and adatrj 319 IF ( nrstdt == 2 ) THEN 320 IF ( nrstdt == 2 ) THEN 320 321 ! read the parameters correspondting to nit000 - 1 (last time step of previous run) 321 322 CALL iom_get( numror, 'ndastp', zndastp ) 322 323 ndastp = NINT( zndastp ) 323 324 CALL iom_get( numror, 'adatrj', adatrj ) 324 ELSE 325 ELSE 325 326 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 326 327 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 327 adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 328 ! note this is wrong if time step has changed during run 328 adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 329 ! note this is wrong if time step has changed during run 329 330 ENDIF 330 331 ELSE 331 332 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 332 333 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 333 adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 334 adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 334 335 ENDIF 335 336 IF( ABS(adatrj - REAL(NINT(adatrj),wp)) < 0.1 / rday ) adatrj = REAL(NINT(adatrj),wp) ! avoid truncation error … … 347 348 IF(lwp) WRITE(numout,*) 348 349 IF(lwp) WRITE(numout,*) 'rst_write : write oce restart file kt =', kt 349 IF(lwp) WRITE(numout,*) '~~~~~~~' 350 IF(lwp) WRITE(numout,*) '~~~~~~~' 350 351 ENDIF 351 352 ! calendar control 352 CALL iom_rstput( kt, nitrst, numrow, 'kt' , REAL( kt , wp) ) ! time-step 353 CALL iom_rstput( kt, nitrst, numrow, 'kt' , REAL( kt , wp) ) ! time-step 353 354 CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) ) ! date 354 355 CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj ) ! number of elapsed days since -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r3680 r3764 68 68 !! - 1D configuration, move Coriolis, u and v at T-point 69 69 !!---------------------------------------------------------------------- 70 INTEGER :: jk 71 INTEGER :: iconf = 0 ! temporaryintegers72 !!---------------------------------------------------------------------- 73 ! 74 IF( nn_timing == 1 ) CALL timing_start('dom_init')70 INTEGER :: jk ! dummy loop argument 71 INTEGER :: iconf = 0 ! local integers 72 !!---------------------------------------------------------------------- 73 ! 74 IF( nn_timing == 1 ) CALL timing_start('dom_init') 75 75 ! 76 76 IF(lwp) THEN … … 88 88 IF( lk_vvl ) CALL dom_vvl ! Vertical variable mesh 89 89 ! 90 IF( lk_c1d ) THEN ! 1D configuration 91 CALL cor_c1d ! Coriolis set at T-point 92 umask(:,:,:) = tmask(:,:,:) ! U, V moved at T-point 93 vmask(:,:,:) = tmask(:,:,:) 94 END IF 95 ! 96 hu(:,:) = 0.e0 ! Ocean depth at U- and V-points 97 hv(:,:) = 0.e0 90 IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point 91 ! 92 hu(:,:) = 0._wp ! Ocean depth at U- and V-points 93 hv(:,:) = 0._wp 98 94 DO jk = 1, jpk 99 95 hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk) … … 101 97 END DO 102 98 ! ! Inverse of the local depth 103 hur(:,:) = 1. / ( hu(:,:) + 1.e0- umask(:,:,1) ) * umask(:,:,1)104 hvr(:,:) = 1. / ( hv(:,:) + 1.e0- vmask(:,:,1) ) * vmask(:,:,1)99 hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 100 hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 105 101 106 102 CALL dom_stp ! time step … … 108 104 IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control 109 105 ! 110 IF( nn_timing == 1 ) CALL timing_stop('dom_init')106 IF( nn_timing == 1 ) CALL timing_stop('dom_init') 111 107 ! 112 108 END SUBROUTINE dom_init … … 294 290 CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 ) 295 291 ELSE 296 ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1. e0)297 ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1. e0)298 ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1. e0)299 ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1. e0)300 301 iloc = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1. e0)292 ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1._wp ) 293 ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1._wp ) 294 ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1._wp ) 295 ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1._wp ) 296 297 iloc = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1._wp ) 302 298 iimi1 = iloc(1) + nimpp - 1 303 299 ijmi1 = iloc(2) + njmpp - 1 304 iloc = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1. e0)300 iloc = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1._wp ) 305 301 iimi2 = iloc(1) + nimpp - 1 306 302 ijmi2 = iloc(2) + njmpp - 1 307 iloc = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1. e0)303 iloc = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1._wp ) 308 304 iima1 = iloc(1) + nimpp - 1 309 305 ijma1 = iloc(2) + njmpp - 1 310 iloc = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1. e0)306 iloc = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1._wp ) 311 307 iima2 = iloc(1) + nimpp - 1 312 308 ijma2 = iloc(2) + njmpp - 1 -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r3702 r3764 16 16 !! 3.3 ! 2010-11 (G. Madec) add mbk. arrays associated to the deepest ocean level 17 17 !! 3.4 ! 2012-08 (J. Siddorn) added Siddorn and Furner stretching function 18 !! 3.4 ! 2012-12 (R. Bourdalle-Badie and G. Reffray) modify C1D case 18 19 !!---------------------------------------------------------------------- 19 20 … … 40 41 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 41 42 USE lib_mpp ! distributed memory computing library 42 USE wrk_nemo ! Memory allocation43 USE timing ! Timing43 USE wrk_nemo ! Memory allocation 44 USE timing ! Timing 44 45 45 46 IMPLICIT NONE … … 84 85 !! *** ROUTINE dom_zgr *** 85 86 !! 86 !! ** Purpose : set the depth of model levels and the resulting87 !! vertical scale factors.87 !! ** Purpose : set the depth of model levels and the resulting 88 !! vertical scale factors. 88 89 !! 89 90 !! ** Method : - reference 1D vertical coordinate (gdep._0, e3._0) … … 97 98 !! ** Action : define gdep., e3., mbathy and bathy 98 99 !!---------------------------------------------------------------------- 99 INTEGER :: ioptio = 0 ! temporaryinteger100 INTEGER :: ioptio, ibat ! local integer 100 101 ! 101 102 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco 102 103 !!---------------------------------------------------------------------- 103 104 ! 104 IF( nn_timing == 1 ) CALL timing_start('dom_zgr')105 IF( nn_timing == 1 ) CALL timing_start('dom_zgr') 105 106 ! 106 107 REWIND( numnam ) ! Read Namelist namzgr : vertical coordinate' … … 118 119 119 120 ioptio = 0 ! Check Vertical coordinate options 120 IF( ln_zco )ioptio = ioptio + 1121 IF( ln_zps )ioptio = ioptio + 1122 IF( ln_sco )ioptio = ioptio + 1121 IF( ln_zco ) ioptio = ioptio + 1 122 IF( ln_zps ) ioptio = ioptio + 1 123 IF( ln_sco ) ioptio = ioptio + 1 123 124 IF( ioptio /= 1 ) CALL ctl_stop( ' none or several vertical coordinate options used' ) 124 125 ! … … 127 128 CALL zgr_z ! Reference z-coordinate system (always called) 128 129 CALL zgr_bat ! Bathymetry fields (levels and meters) 130 IF( lk_c1d ) CALL lbc_lnk( bathy , 'T', 1._wp ) ! 1D config.: same bathy value over the 3x3 domain 129 131 IF( ln_zco ) CALL zgr_zco ! z-coordinate 130 132 IF( ln_zps ) CALL zgr_zps ! Partial step z-coordinate … … 134 136 ! ----------------------------------- 135 137 IF( lzoom ) CALL zgr_bat_zoom ! correct mbathy in case of zoom subdomain 136 IF( .NOT.lk_c1d ) CALL zgr_bat_ctl ! check bathymetry (mbathy) and suppress iso ated ocean points138 IF( .NOT.lk_c1d ) CALL zgr_bat_ctl ! check bathymetry (mbathy) and suppress isolated ocean points 137 139 CALL zgr_bot_level ! deepest ocean level for t-, u- and v-points 138 140 ! 139 ! 140 141 IF( lk_c1d ) THEN ! 1D config.: same mbathy value over the 3x3 domain 142 ibat = mbathy(2,2) 143 mbathy(:,:) = ibat 144 END IF 145 ! 141 146 IF( nprint == 1 .AND. lwp ) THEN 142 147 WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) … … 478 483 END DO 479 484 END DO 480 IF(lwp) WRITE(numout,*) 485 IF(lwp) WRITE(numout,*) 481 486 IF(lwp) WRITE(numout,*) ' orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0 482 487 ! … … 742 747 ! 743 748 mbkt(:,:) = MAX( mbathy(:,:) , 1 ) ! bottom k-index of T-level (=1 over land) 749 744 750 ! ! bottom k-index of W-level = mbkt+1 745 751 DO jj = 1, jpjm1 ! bottom k-index of u- (v-) level … … 1220 1226 END DO 1221 1227 ! 1222 ! Apply lateral boundary condition CAUTION: ke ptthe value when the lbc field is zero1228 ! Apply lateral boundary condition CAUTION: keep the value when the lbc field is zero 1223 1229 ztmp(:,:) = zenv(:,:) ; CALL lbc_lnk( zenv, 'T', 1._wp ) 1224 1230 DO jj = 1, nlcj … … 1231 1237 ! ! ================ ! 1232 1238 ! 1233 ! ! envelop bathymetry saved in hbatt 1239 ! Fill ghost rows with appropriate values to avoid undefined e3 values with some mpp decompositions 1240 DO ji = nlci+1, jpi 1241 zenv(ji,1:nlcj) = zenv(nlci,1:nlcj) 1242 END DO 1243 ! 1244 DO jj = nlcj+1, jpj 1245 zenv(:,jj) = zenv(:,nlcj) 1246 END DO 1247 ! 1248 ! Envelope bathymetry saved in hbatt 1234 1249 hbatt(:,:) = zenv(:,:) 1235 1250 IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0._wp ) THEN -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r3680 r3764 41 41 USE dynspg_exp ! pressure gradient schemes 42 42 USE dynspg_ts ! pressure gradient schemes 43 USE sol_oce ! ocean solver variables 43 44 USE lib_mpp ! MPP library 44 45 USE restart ! restart … … 106 107 hdivb(:,:,:) = 0._wp ; hdivn(:,:,:) = 0._wp 107 108 ! 108 ! ! define e3u_b, e3v_b from e3t_b initialized in domzgr109 CALL dom_vvl_2( nit000, fse3u_b(:,:,:), fse3v_b(:,:,:) )110 !111 109 IF( cp_cfg == 'eel' ) THEN 112 110 CALL istate_eel ! EEL configuration : start from pre-defined U,V T-S fields … … 133 131 ENDDO 134 132 ENDIF 133 ! ! define e3u_b, e3v_b from e3t_b initialized in domzgr 134 CALL dom_vvl_2( nit000, fse3u_b(:,:,:), fse3v_b(:,:,:) ) 135 135 ! 136 136 ENDIF … … 138 138 IF( lk_agrif ) THEN ! read free surface arrays in restart file 139 139 IF( ln_rstart ) THEN 140 IF( lk_dynspg_flt ) CALL flt_rst( nit000, 'READ' ) ! read or initialize the following fields 141 ! ! gcx, gcxb for agrif_opa_init 142 ENDIF ! explicit case not coded yet with AGRIF 140 IF( lk_dynspg_flt ) THEN ! read or initialize the following fields 141 ! ! gcx, gcxb for agrif_opa_init 142 IF( sol_oce_alloc() > 0 ) CALL ctl_stop('agrif sol_oce_alloc: allocation of arrays failed') 143 CALL flt_rst( nit000, 'READ' ) 144 ENDIF 145 ENDIF ! explicit case not coded yet with AGRIF 143 146 ENDIF 144 147 !
Note: See TracChangeset
for help on using the changeset viewer.
