Changeset 2444
- Timestamp:
- 2010-11-29T15:30:48+01:00 (14 years ago)
- Location:
- branches/nemo_v3_3_beta/NEMOGCM
- Files:
-
- 1 deleted
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/nemo_v3_3_beta/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/cpp_ORCA2_OFF_PISCES.fcm
r2340 r2444 1 bld::tool::fppkeys key_trabbl key_vectopt_loop key_orca_r2 key_dynspg_flt key_ldfslp key_traldf_c2d key_traldf_eiv key_zdftke key_ zdfddm key_top key_offline key_pisces key_dtatrc key_diatrc key_iomput key_nproci=1 key_nprocj=11 bld::tool::fppkeys key_trabbl key_vectopt_loop key_orca_r2 key_dynspg_flt key_ldfslp key_traldf_c2d key_traldf_eiv key_zdftke key_top key_offline key_pisces key_dtatrc key_diatrc key_iomput key_nproci=1 key_nprocj=1 -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OFF_SRC/dommsk.F90
r2287 r2444 1 1 MODULE dommsk 2 !!====================================================================== ========2 !!====================================================================== 3 3 !! *** MODULE dommsk *** 4 !! Ocean initialization : domain land/sea mask 5 !!============================================================================== 4 !! Ocean initialization : domain land/sea masks, off-line case 5 !!====================================================================== 6 !! History : 3.3 ! 2010-10 (C. Ethe) adapted from OPA_SRC/DOM/dommsk 7 !!---------------------------------------------------------------------- 6 8 7 9 !!---------------------------------------------------------------------- 8 10 !! dom_msk : compute land/ocean mask 9 11 !!---------------------------------------------------------------------- 10 !! * Modules used11 12 USE oce ! ocean dynamics and tracers 12 13 USE dom_oce ! ocean space and time domain 13 14 USE in_out_manager ! I/O manager 14 USE lbclnk ! ocean lateral boundary conditions (or mpp link)15 USE lib_mpp16 15 17 16 IMPLICIT NONE 18 17 PRIVATE 19 18 20 !! * Routine accessibility 21 PUBLIC dom_msk ! routine called by inidom.F90 19 PUBLIC dom_msk ! routine called by inidom.F90 22 20 23 !! * Module variables24 21 #if defined key_degrad 25 22 !! ------------------------------------------------ 26 23 !! Degradation method 27 24 !! -------------------------------------------------- 28 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: & 29 facvol !! volume for degraded regions 25 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: facvol !! volume for degraded regions 30 26 #endif 27 31 28 !! * Substitutions 32 29 # include "vectopt_loop_substitute.h90" … … 34 31 !! NEMO/OFF 3.3 , NEMO Consortium (2010) 35 32 !! $Id$ 36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 37 34 !!---------------------------------------------------------------------- 38 39 35 CONTAINS 40 36 … … 43 39 !! *** ROUTINE dom_msk *** 44 40 !! 45 !! ** Purpose : Compute land/ocean mask arrays at tracer points, hori- 46 !! zontal velocity points (u & v), vorticity points (f) and baro- 47 !! tropic stream function points (b). 48 !! Set mbathy to the number of non-zero w-levels of a water column 49 !! (if island in the domain (lk_isl=T), this is done latter in 50 !! routine solver_init) 41 !! ** Purpose : Off-line case: defines the interior domain T-mask. 51 42 !! 52 !! ** Method : The ocean/land mask is computed from the basin bathy-53 !! metry in level (mbathy) which is defined or read in dommba.54 !! mbathy equals 0 over continental T-point, -n over the nth55 !! island T-point, and the number of ocean level over the ocean.43 !! ** Method : The interior ocean/land mask is computed from tmask 44 !! setting to zero the duplicated row and lines due to 45 !! MPP exchange halos, est-west cyclic and north fold 46 !! boundary conditions. 56 47 !! 57 !! At a given position (ji,jj,jk) the ocean/land mask is given by: 58 !! t-point : 0. IF mbathy( ji ,jj) =< 0 59 !! 1. IF mbathy( ji ,jj) >= jk 60 !! u-point : 0. IF mbathy( ji ,jj) or mbathy(ji+1, jj ) =< 0 61 !! 1. IF mbathy( ji ,jj) and mbathy(ji+1, jj ) >= jk. 62 !! v-point : 0. IF mbathy( ji ,jj) or mbathy( ji ,jj+1) =< 0 63 !! 1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) >= jk. 64 !! f-point : 0. IF mbathy( ji ,jj) or mbathy( ji ,jj+1) 65 !! or mbathy(ji+1,jj) or mbathy(ji+1,jj+1) =< 0 66 !! 1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) 67 !! and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk. 68 !! b-point : the same definition as for f-point of the first ocean 69 !! level (surface level) but with 0 along coastlines. 70 !! 71 !! The lateral friction is set through the value of fmask along 72 !! the coast and topography. This value is defined by shlat, a 73 !! namelist parameter: 74 !! shlat = 0, free slip (no shear along the coast) 75 !! shlat = 2, no slip (specified zero velocity at the coast) 76 !! 0 < shlat < 2, partial slip | non-linear velocity profile 77 !! 2 < shlat, strong slip | in the lateral boundary layer 78 !! 79 !! N.B. If nperio not equal to 0, the land/ocean mask arrays 80 !! are defined with the proper value at lateral domain boundaries, 81 !! but bmask. indeed, bmask defined the domain over which the 82 !! barotropic stream function is computed. this domain cannot 83 !! contain identical columns because the matrix associated with 84 !! the barotropic stream function equation is then no more inverti- 85 !! ble. therefore bmask is set to 0 along lateral domain boundaries 86 !! even IF nperio is not zero. 87 !! 88 !! In case of open boundaries (lk_obc=T): 89 !! - tmask is set to 1 on the points to be computed bay the open 90 !! boundaries routines. 91 !! - bmask is set to 0 on the open boundaries. 92 !! 93 !! Set mbathy to the number of non-zero w-levels of a water column 94 !! mbathy = min( mbathy, 1 ) + 1 95 !! (note that the minimum value of mbathy is 2). 96 !! 97 !! ** Action : 98 !! tmask : land/ocean mask at t-point (=0. or 1.) 99 !! umask : land/ocean mask at u-point (=0. or 1.) 100 !! vmask : land/ocean mask at v-point (=0. or 1.) 101 !! fmask : land/ocean mask at f-point (=0. or 1.) 102 !! =shlat along lateral boundaries 103 !! bmask : land/ocean mask at barotropic stream 104 !! function point (=0. or 1.) and set to 105 !! 0 along lateral boundaries 106 !! mbathy : number of non-zero w-levels 107 !! 108 !! History : 109 !! ! 87-07 (G. Madec) Original code 110 !! ! 91-12 (G. Madec) 111 !! ! 92-06 (M. Imbard) 112 !! ! 93-03 (M. Guyon) symetrical conditions (M. Guyon) 113 !! ! 96-01 (G. Madec) suppression of common work arrays 114 !! ! 96-05 (G. Madec) mask computed from tmask and sup- 115 !! pression of the double computation of bmask 116 !! ! 97-02 (G. Madec) mesh information put in domhgr.F 117 !! ! 97-07 (G. Madec) modification of mbathy and fmask 118 !! ! 98-05 (G. Roullet) free surface 119 !! ! 00-03 (G. Madec) no slip accurate 120 !! ! 01-09 (J.-M. Molines) Open boundaries 121 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 48 !! ** Action : tmask_i : interiorland/ocean mask at t-point 49 !! tpol : ??? 122 50 !!---------------------------------------------------------------------- 123 !! *Local declarations 124 INTEGER :: ji, jk ! dummy loop indices 125 INTEGER :: iif, iil, ijf, ijl 126 INTEGER, DIMENSION(jpi,jpj) :: imsk 127 51 INTEGER :: ji, jk ! dummy loop indices 52 INTEGER :: iif, iil, ijf, ijl ! local integers 53 INTEGER, DIMENSION(jpi,jpj) :: imsk ! 2D workspace 128 54 !!--------------------------------------------------------------------- 129 130 131 55 ! 132 56 ! Interior domain mask (used for global sum) 133 57 ! -------------------- 134 135 58 tmask_i(:,:) = tmask(:,:,1) 136 iif = jpreci ! ???59 iif = jpreci ! thickness of exchange halos in i-axis 137 60 iil = nlci - jpreci + 1 138 ijf = jprecj ! ???61 ijf = jprecj ! thickness of exchange halos in j-axis 139 62 ijl = nlcj - jprecj + 1 140 141 tmask_i( 1 :iif, : ) = 0.e0 ! first columns 142 tmask_i(iil:jpi, : ) = 0.e0 ! last columns (including mpp extra columns) 143 tmask_i( : , 1 :ijf) = 0.e0 ! first rows 144 tmask_i( : ,ijl:jpj) = 0.e0 ! last rows (including mpp extra rows) 145 146 147 ! north fold mask 148 tpol(1:jpiglo) = 1.e0 149 IF( jperio == 3 .OR. jperio == 4 ) THEN ! T-point pivot 150 tpol(jpiglo/2+1:jpiglo) = 0.e0 151 ENDIF 152 IF( jperio == 5 .OR. jperio == 6 ) THEN ! F-point pivot 153 tpol( 1 :jpiglo) = 0.e0 154 ENDIF 155 63 ! 64 tmask_i( 1 :iif, : ) = 0._wp ! first columns 65 tmask_i(iil:jpi, : ) = 0._wp ! last columns (including mpp extra columns) 66 tmask_i( : , 1 :ijf) = 0._wp ! first rows 67 tmask_i( : ,ijl:jpj) = 0._wp ! last rows (including mpp extra rows) 68 ! 69 ! ! north fold mask 70 tpol(1:jpiglo) = 1._wp 71 ! 72 IF( jperio == 3 .OR. jperio == 4 ) tpol(jpiglo/2+1:jpiglo) = 0._wp ! T-point pivot 73 IF( jperio == 5 .OR. jperio == 6 ) tpol( 1 :jpiglo) = 0._wp ! F-point pivot 156 74 IF( jperio == 3 .OR. jperio == 4 ) THEN ! T-point pivot: only half of the nlcj-1 row 157 if (mjg(ijl-1) == jpjglo-1) then158 DO ji = iif+1, iil-1159 tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji))160 END DO161 endif75 IF( mjg(ijl-1) == jpjglo-1 ) THEN 76 DO ji = iif+1, iil-1 77 tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji)) 78 END DO 79 ENDIF 162 80 ENDIF 163 164 ! Control print 165 ! ------------- 166 IF( nprint == 1 .AND. lwp ) THEN 81 ! 82 IF( nprint == 1 .AND. lwp ) THEN ! Control print 167 83 imsk(:,:) = INT( tmask_i(:,:) ) 168 84 WRITE(numout,*) ' tmask_i : ' 169 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, & 170 & 1, jpj, 1, 1, numout) 85 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout) 171 86 WRITE (numout,*) 172 87 WRITE (numout,*) ' dommsk: tmask for each level' … … 174 89 DO jk = 1, jpk 175 90 imsk(:,:) = INT( tmask(:,:,jk) ) 176 177 91 WRITE(numout,*) 178 92 WRITE(numout,*) ' level = ',jk 179 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, & 180 & 1, jpj, 1, 1, numout) 93 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout) 181 94 END DO 182 95 ENDIF 183 96 ! 184 97 END SUBROUTINE dom_msk 185 98 99 !!====================================================================== 186 100 END MODULE dommsk -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OFF_SRC/domrea.F90
r2431 r2444 11 11 !! = 3 : mesh_hgr, mesh_zgr and mask 12 12 !!---------------------------------------------------------------------- 13 !! * Modules used14 13 USE dom_oce ! ocean space and time domain 15 USE dommsk 16 USE in_out_manager 14 USE dommsk ! domain: masks 15 USE in_out_manager ! I/O manager 17 16 18 17 IMPLICIT NONE 19 18 PRIVATE 20 19 21 !! * Accessibility 22 PUBLIC dom_rea ! routine called by inidom.F90 20 PUBLIC dom_rea ! routine called by inidom.F90 23 21 !!---------------------------------------------------------------------- 24 22 !! NEMO/OFF 3.3 , NEMO Consortium (2010) … … 29 27 CONTAINS 30 28 31 #if ( defined key_mpp_mpi || defined key_mpp_shmem ) &&defined key_dimgout29 #if defined key_mpp_mpi && defined key_dimgout 32 30 !!---------------------------------------------------------------------- 33 31 !! 'key_mpp_mpi' OR 34 !! 'key_mpp_shmem'35 32 !! 'key_dimgout' : each processor makes its own direct access file 36 33 !! use build_nc_meshmask off line to retrieve … … 38 35 !!---------------------------------------------------------------------- 39 36 # include "domrea_dimg.h90" 40 41 37 42 38 #else … … 67 63 !! meshmask.nc : domain size, horizontal grid-point position, 68 64 !! masks, depth and vertical scale factors 65 !!---------------------------------------------------------------------- 66 USE iom 69 67 !! 70 !! History : 71 !! ! 97-02 (G. Madec) Original code 72 !! ! 99-11 (M. Imbard) NetCDF FORMAT with IOIPSL 73 !! 9.0 ! 02-08 (G. Madec) F90 and several file 74 !! ! 06-07 (C. Ethe ) Use of iom module 68 INTEGER :: ji, jj, jk ! dummy loop indices 69 INTEGER :: ik, inum0 , inum1 , inum2 , inum3 , inum4 ! local integers 70 REAL(wp) :: zrefdep ! local real 71 REAL(wp), DIMENSION(jpi,jpj) :: zprt ! 2D workspace 75 72 !!---------------------------------------------------------------------- 76 !! * Modules used 77 USE iom 78 79 !! * Local declarations 80 INTEGER :: ji, jj, jk 81 INTEGER :: & !!! * temprary units for : 82 inum0 , & ! 'mesh_mask.nc' file 83 inum1 , & ! 'mesh.nc' file 84 inum2 , & ! 'mask.nc' file 85 inum3 , & ! 'mesh_hgr.nc' file 86 inum4 ! 'mesh_zgr.nc' file 87 88 REAL(wp), DIMENSION(jpi,jpj) :: zprt 89 REAL(wp) :: zrefdep ! depth of the reference level (~10m) 90 INTEGER :: ik 91 !!---------------------------------------------------------------------- 92 93 IF(lwp) WRITE(numout,*) 94 IF(lwp) WRITE(numout,*) 'dom_rea : read NetCDF mesh and mask information file(s)' 95 IF(lwp) WRITE(numout,*) '~~~~~~~' 96 97 98 zprt(:,:) = 0. 73 74 IF(lwp) WRITE(numout,*) 75 IF(lwp) WRITE(numout,*) 'dom_rea : read NetCDF mesh and mask information file(s)' 76 IF(lwp) WRITE(numout,*) '~~~~~~~' 77 78 zprt(:,:) = 0._wp 99 79 100 80 SELECT CASE (nmsh) … … 180 160 DO jj = 1, jpj 181 161 DO ji = 1, jpi 182 mbathy(ji,jj) = MAX( zprt(ji,jj) * tmask(ji,jj,1), 1. ) + 1162 mbathy(ji,jj) = MAX( zprt(ji,jj) * tmask(ji,jj,1), 1._wp ) + 1 183 163 ENDDO 184 164 ENDDO … … 262 242 !!gm BUG in s-coordinate this does not work! 263 243 ! deepest/shallowest W level Above/Below ~10m 264 zrefdep = 10. - ( 0.1*MINVAL(e3w_0) )! ref. depth with tolerance (10% of minimum layer thickness)244 zrefdep = 10._wp - ( 0.1_wp * MINVAL(e3w_0) ) ! ref. depth with tolerance (10% of minimum layer thickness) 265 245 nlb10 = MINLOC( gdepw_0, mask = gdepw_0 > zrefdep, dim = 1 ) ! shallowest W level Below ~10m 266 246 nla10 = nlb10 - 1 ! deepest W level Above ~10m … … 308 288 309 289 DO jk = 1, jpk 310 IF( e3w_0 (jk) <= 0. .OR. e3t_0(jk) <= 0. ) CALL ctl_stop( ' e3w_0 or e3t_0 =< 0 ' )311 IF( gdepw_0(jk) < 0. .OR. gdept_0(jk) < 0.)CALL ctl_stop( ' gdepw_0 or gdept_0 < 0 ' )290 IF( e3w_0 (jk) <= 0._wp .OR. e3t_0 (jk) <= 0._wp ) CALL ctl_stop( ' e3w_0 or e3t_0 =< 0 ' ) 291 IF( gdepw_0(jk) < 0._wp .OR. gdept_0(jk) < 0._wp ) CALL ctl_stop( ' gdepw_0 or gdept_0 < 0 ' ) 312 292 END DO 313 314 ! ! ============================ 315 ! ! close the files 316 ! ! ============================ 317 SELECT CASE ( nmsh ) 318 CASE ( 1 ) 319 CALL iom_close( inum0 ) 320 CASE ( 2 ) 321 CALL iom_close( inum1 ) 322 CALL iom_close( inum2 ) 323 CASE ( 3 ) 324 CALL iom_close( inum2 ) 325 CALL iom_close( inum3 ) 326 CALL iom_close( inum4 ) 327 END SELECT 328 293 ! ! ============================ 294 ! ! close the files 295 ! ! ============================ 296 SELECT CASE ( nmsh ) 297 CASE ( 1 ) 298 CALL iom_close( inum0 ) 299 CASE ( 2 ) 300 CALL iom_close( inum1 ) 301 CALL iom_close( inum2 ) 302 CASE ( 3 ) 303 CALL iom_close( inum2 ) 304 CALL iom_close( inum3 ) 305 CALL iom_close( inum4 ) 306 END SELECT 307 ! 329 308 END SUBROUTINE dom_rea 330 309 -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r2435 r2444 2 2 !!====================================================================== 3 3 !! *** MODULE dtadyn *** 4 !! OFFLINE : interpolation of the physical fields 5 !!===================================================================== 4 !! Off-line : interpolation of the physical fields 5 !!====================================================================== 6 !! History : OPA ! 1992-01 (M. Imbard) Original code 7 !! 8.0 ! 1998-04 (L.Bopp MA Foujols) slopes for isopyc. 8 !! - ! 1998-05 (L. Bopp) read output of coupled run 9 !! 8.2 ! 2001-01 (M. Levy et M. Benjelloul) add netcdf FORMAT 10 !! NEMO 1.0 ! 2005-03 (O. Aumont and A. El Moussaoui) F90 11 !! - ! 2005-12 (C. Ethe) Adapted for DEGINT 12 !! 3.0 ! 2007-06 (C. Ethe) use of iom module 13 !! - ! 2007-09 (C. Ethe) add swap_dyn_data 14 !! 3.3 ! 2010-11 (C. Ethe) Full reorganization of the off-line: phasing with the on-line 15 !!---------------------------------------------------------------------- 6 16 7 17 !!---------------------------------------------------------------------- … … 9 19 !! dta_dyn : Interpolation of the fields 10 20 !!---------------------------------------------------------------------- 11 !! * Modules used12 21 USE oce ! ocean dynamics and tracers variables 13 USE dom_oce ! ocean space and time domain variables 14 USE zdf_oce ! ocean vertical physics 15 USE in_out_manager ! I/O manager 22 USE c1d ! 1D configuration: lk_c1d 23 USE dom_oce ! ocean domain: variables 24 USE zdf_oce ! ocean vertical physics: variables 25 USE sbc_oce ! surface module: variables 16 26 USE phycst ! physical constants 17 USE sbc_oce 18 USE trabbl 19 USE ldfslp 27 USE trabbl ! active tracer: bottom boundary layer 28 USE ldfslp ! lateral diffusion: iso-neutral slopes 20 29 USE ldfeiv ! eddy induced velocity coef. 21 30 USE ldftra_oce ! ocean tracer lateral physics 22 USE zdfmxl 23 USE eosbn2 24 USE zdfddm ! vertical physics: double diffusion 31 USE zdfmxl ! vertical physics: mixed layer depth 32 USE eosbn2 ! equation of state - Brunt Vaisala frequency 25 33 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 26 USE zpshde 34 USE zpshde ! z-coord. with partial steps: horizontal derivatives 35 USE in_out_manager ! I/O manager 36 USE iom ! I/O library 27 37 USE lib_mpp ! distributed memory computing library 28 USE c1d29 38 30 39 IMPLICIT NONE 31 40 PRIVATE 32 41 33 !! * Routine accessibility 34 PUBLIC dta_dyn_init ! called by opa.F90 35 PUBLIC dta_dyn ! called by step.F90 36 37 LOGICAL , PUBLIC :: & 38 lperdyn = .TRUE. , & ! boolean for periodic fields or not 39 lfirdyn = .TRUE. ! boolean for the first call or not 40 41 INTEGER , PUBLIC :: & 42 ndtadyn = 73 , & ! Number of dat in one year 43 ndtatot = 73 , & ! Number of data in the input field 44 nsptint = 1 ! type of spatial interpolation 45 46 CHARACTER(len=45) :: & 47 cfile_grid_T = 'dyna_grid_T.nc', & !: name of the grid_T file 48 cfile_grid_U = 'dyna_grid_U.nc', & !: name of the grid_U file 49 cfile_grid_V = 'dyna_grid_V.nc', & !: name of the grid_V file 50 cfile_grid_W = 'dyna_grid_W.nc' !: name of the grid_W file 42 PUBLIC dta_dyn_init ! called by opa.F90 43 PUBLIC dta_dyn ! called by step.F90 44 45 LOGICAL, PUBLIC :: lperdyn = .TRUE. !: boolean for periodic fields or not 46 LOGICAL, PUBLIC :: lfirdyn = .TRUE. !: boolean for the first call or not 47 48 INTEGER, PUBLIC :: ndtadyn = 73 !: Number of dat in one year 49 INTEGER, PUBLIC :: ndtatot = 73 !: Number of data in the input field 50 INTEGER, PUBLIC :: nsptint = 1 !: type of spatial interpolation 51 52 CHARACTER(len=45) :: cfile_grid_T = 'dyna_grid_T.nc' ! name of the grid_T file 53 CHARACTER(len=45) :: cfile_grid_U = 'dyna_grid_U.nc' ! name of the grid_U file 54 CHARACTER(len=45) :: cfile_grid_V = 'dyna_grid_V.nc' ! name of the grid_V file 55 CHARACTER(len=45) :: cfile_grid_W = 'dyna_grid_W.nc' ! name of the grid_W file 51 56 52 REAL(wp) :: & 53 rnspdta , & !: number of time step per 2 consecutives data 54 rnspdta2 !: rnspdta * 0.5 55 56 INTEGER :: & 57 ndyn1, ndyn2 , & 58 nlecoff = 0 , & ! switch for the first read 59 numfl_t, numfl_u, & 60 numfl_v, numfl_w 61 62 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 63 tdta , & ! temperature at two consecutive times 64 sdta , & ! salinity at two consecutive times 65 udta , & ! zonal velocity at two consecutive times 66 vdta , & ! meridional velocity at two consecutive times 67 wdta , & ! vertical velocity at two consecutive times 68 avtdta ! vertical diffusivity coefficient 69 70 REAL(wp), DIMENSION(jpi,jpj,2) :: & 71 hmlddta, & ! mixed layer depth at two consecutive times 72 wspddta, & ! wind speed at two consecutive times 73 frlddta, & ! sea-ice fraction at two consecutive times 74 empdta , & ! E-P at two consecutive times 75 qsrdta ! short wave heat flux at two consecutive times 76 57 REAL(wp) :: rnspdta ! number of time step per 2 consecutives data 58 REAL(wp) :: rnspdta2 ! rnspdta * 0.5 59 60 INTEGER :: ndyn1, ndyn2 ! 61 INTEGER :: nlecoff = 0 ! switch for the first read 62 INTEGER :: numfl_t, numfl_u, numfl_v, numfl_w 63 64 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: tdta ! temperature at two consecutive times 65 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: sdta ! salinity at two consecutive times 66 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: udta ! zonal velocity at two consecutive times 67 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: vdta ! meridional velocity at two consecutive times 68 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: wdta ! vertical velocity at two consecutive times 69 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: avtdta ! vertical diffusivity coefficient 70 71 REAL(wp), DIMENSION(jpi,jpj ,2) :: hmlddta ! mixed layer depth at two consecutive times 72 REAL(wp), DIMENSION(jpi,jpj ,2) :: wspddta ! wind speed at two consecutive times 73 REAL(wp), DIMENSION(jpi,jpj ,2) :: frlddta ! sea-ice fraction at two consecutive times 74 REAL(wp), DIMENSION(jpi,jpj ,2) :: empdta ! E-P at two consecutive times 75 REAL(wp), DIMENSION(jpi,jpj ,2) :: qsrdta ! short wave heat flux at two consecutive times 77 76 #if defined key_ldfslp 78 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 79 uslpdta , & ! zonal isopycnal slopes 80 vslpdta , & ! meridional isopycnal slopes 81 wslpidta , & ! zonal diapycnal slopes 82 wslpjdta ! meridional diapycnal slopes 83 #endif 84 77 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: uslpdta ! zonal isopycnal slopes 78 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: vslpdta ! meridional isopycnal slopes 79 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: wslpidta ! zonal diapycnal slopes 80 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: wslpjdta ! meridional diapycnal slopes 81 #endif 85 82 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 86 REAL(wp), DIMENSION(jpi,jpj,2) :: & 87 aeiwdta ! G&M coefficient 88 #endif 89 83 REAL(wp), DIMENSION(jpi,jpj ,2) :: aeiwdta ! G&M coefficient 84 #endif 90 85 #if defined key_degrad 91 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 92 ahtudta, ahtvdta, ahtwdta ! Lateral diffusivity 86 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: ahtudta, ahtvdta, ahtwdta ! Lateral diffusivity 93 87 # if defined key_traldf_eiv 94 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 95 aeiudta, aeivdta, aeiwdta ! G&M coefficient 88 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: aeiudta, aeivdta, aeiwdta ! G&M coefficient 96 89 # endif 97 98 90 #endif 99 91 … … 104 96 !! NEMO/OFF 3.3 , NEMO Consortium (2010) 105 97 !! $Id$ 106 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)98 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 107 99 !!---------------------------------------------------------------------- 108 109 100 CONTAINS 110 101 … … 113 104 !! *** ROUTINE dta_dyn *** 114 105 !! 115 !! ** Purpose : Prepares dynamics and physics fields from an 116 !! OPA9 simulation for an off-line simulation 117 !! for passive tracer 106 !! ** Purpose : Prepares dynamics and physics fields from an NEMO run 107 !! for an off-line simulation of passive tracers 118 108 !! 119 109 !! ** Method : calculates the position of DATA to read READ DATA 120 110 !! (example month changement) computes slopes IF needed 121 111 !! interpolates DATA IF needed 122 !! 123 !! ** History : 124 !! ! original : 92-01 (M. Imbard: sub domain) 125 !! ! addition : 98-04 (L.Bopp MA Foujols: slopes for isopyc.) 126 !! ! addition : 98-05 (L. Bopp read output of coupled run) 127 !! ! addition : 05-03 (O. Aumont and A. El Moussaoui) F90 128 !! ! addition : 05-12 (C. Ethe) Adapted for DEGINT 129 !!---------------------------------------------------------------------- 130 !! * Arguments 131 INTEGER, INTENT( in ) :: kt ! ocean time-step index 132 133 !! * Local declarations 134 INTEGER :: iper, iperm1, iswap, izt 135 136 REAL(wp) :: zt 137 REAL(wp) :: zweigh 138 !!---------------------------------------------------------------------- 139 140 zt = ( FLOAT (kt) + rnspdta2 ) / rnspdta 141 izt = INT( zt ) 142 zweigh = zt - FLOAT( INT(zt) ) 143 144 IF( lperdyn ) THEN 145 iperm1 = MOD( izt, ndtadyn ) 146 ELSE 147 iperm1 = MOD( izt, ndtatot - 1 ) + 1 112 !!---------------------------------------------------------------------- 113 INTEGER, INTENT(in) :: kt ! ocean time-step index 114 !! 115 INTEGER :: iper, iperm1, iswap, izt ! local integers 116 REAL(wp) :: zt, zweigh ! local scalars 117 !!---------------------------------------------------------------------- 118 119 zt = ( REAL(kt,wp) + rnspdta2 ) / rnspdta 120 izt = INT( zt ) 121 zweigh = zt - REAL( INT(zt), wp ) 122 123 IF( lperdyn ) THEN ; iperm1 = MOD( izt, ndtadyn ) 124 ELSE ; iperm1 = MOD( izt, ndtatot - 1 ) + 1 148 125 ENDIF 149 126 … … 154 131 ELSE 155 132 IF( lfirdyn ) THEN 156 IF (lwp) WRITE (numout,*) & 157 & ' dynamic file is not periodic with or without interpolation & 158 & we take the first value for the previous period iperm1 = 0 ' 133 IF(lwp) WRITE (numout,*) 'dta_dyn: dynamic file is not periodic with or without interpolation & 134 & we take the first value for the previous period iperm1 = 0 ' 159 135 END IF 160 136 END IF … … 167 143 168 144 IF( lfirdyn ) THEN 169 ! store the information of the period read 170 ndyn1 = iperm1 145 ndyn1 = iperm1 ! store the information of the period read 171 146 ndyn2 = iper 172 147 173 IF 174 WRITE (numout,*) ' dynamics data read for the period ndyn1 =', ndyn1,&175 & ' and for the period ndyn2 = ', ndyn2148 IF(lwp) THEN 149 WRITE (numout,*) ' dynamics data read for the period ndyn1 =', ndyn1, & 150 & ' and for the period ndyn2 = ', ndyn2 176 151 WRITE (numout,*) ' time step is : ', kt 177 WRITE (numout,*) ' we have ndtadyn = ', ndtadyn,' records in the dynamic file for one year'152 WRITE (numout,*) ' we have ndtadyn = ', ndtadyn, ' records in the dynamic file for one year' 178 153 END IF 179 154 ! 180 IF( iperm1 /= 0 ) THEN ! data read for the iperm1 period 181 CALL dynrea( kt, iperm1 )182 ELSE 183 CALL dynrea( kt, 1)184 ENDIF155 !!gm simplier: CALL dynrea( kt, MAX( 1, iperm1) ) 156 CALL dynrea( kt, MAX( 1, iperm1) ) 157 !! IF( iperm1 /= 0 ) THEN ; CALL dynrea( kt, iperm1 ) ! data read for the iperm1 period 158 !! ELSE ; CALL dynrea( kt, 1 ) 159 !! ENDIF 185 160 186 IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN 187 ! Computes slopes. Caution : here tsn and avt are used as workspace 161 IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN ! Computes slopes (here tsn and avt are used as workspace) 188 162 tsn (:,:,:,jp_tem) = tdta (:,:,:,2) 189 163 tsn (:,:,:,jp_sal) = sdta (:,:,:,2) … … 195 169 & CALL zps_hde( kt, jpts, tsn, gtsu, gtsv, & ! Partial steps: before Horizontal DErivative 196 170 & rhd, gru , grv ) ! of t, s, rd at the bottom ocean level 197 CALL zdf_mxl( kt )! mixed layer depth198 171 CALL zdf_mxl( kt ) ! mixed layer depth 172 CALL ldf_slp( kt, rhd, rn2 ) 199 173 200 174 uslpdta (:,:,:,2) = uslp (:,:,:) … … 203 177 wslpjdta(:,:,:,2) = wslpj(:,:,:) 204 178 END IF 205 206 ! swap from record 2 to 1 207 CALL swap_dyn_data 208 179 ! 180 CALL swap_dyn_data ! swap from record 2 to 1 181 ! 209 182 iswap = 1 ! indicates swap 210 211 CALL dynrea( kt, iper ) ! data read for the iper period 212 213 IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN 214 ! Computes slopes. Caution : here tsn and avt are used as workspace 183 ! 184 CALL dynrea( kt, iper ) ! data read for the iper period 185 ! 186 IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN ! Computes slopes (here tsn and avt are used as workspace) 215 187 tsn (:,:,:,jp_tem) = tdta (:,:,:,2) 216 188 tsn (:,:,:,jp_sal) = sdta (:,:,:,2) 217 189 avt(:,:,:) = avtdta(:,:,:,2) 218 219 CALL eos( tsn, rhd, rhop ) ! Time-filtered in situ density 220 CALL bn2( tsn, rn2 ) ! before Brunt-Vaisala frequency 221 IF( ln_zps ) & 222 & CALL zps_hde( kt, jpts, tsn, gtsu, gtsv, & ! Partial steps: before Horizontal DErivative 223 & rhd, gru , grv ) ! of t, s, rd at the bottom ocean level 224 CALL zdf_mxl( kt ) ! mixed layer depth 225 CALL ldf_slp( kt, rhd, rn2 ) 226 190 ! 191 CALL eos( tsn, rhd, rhop ) ! now in situ density 192 CALL bn2( tsn, rn2 ) ! now Brunt-Vaisala frequency 193 IF( ln_zps ) CALL zps_hde( kt, jpts, tsn, gtsu, gtsv, & ! Partial steps: before Horizontal DErivative 194 & rhd, gru , grv ) ! of t, s, rd at the bottom ocean level 195 CALL zdf_mxl( kt ) ! mixed layer depth 196 CALL ldf_slp( kt, rhd, rn2 ) ! slope of iso-neutral surfaces 197 ! 227 198 uslpdta (:,:,:,2) = uslp (:,:,:) 228 199 vslpdta (:,:,:,2) = vslp (:,:,:) … … 231 202 END IF 232 203 ! 233 lfirdyn =.FALSE. ! trace the first call204 lfirdyn = .FALSE. ! trace the first call 234 205 ENDIF 235 206 ! … … 238 209 ! 239 210 IF( iperm1 /= ndyn1 ) THEN 240 241 IF( iperm1 == 0 .) THEN242 IF 211 ! 212 IF( iperm1 == 0 ) THEN 213 IF(lwp) THEN 243 214 WRITE (numout,*) ' dynamic file is not periodic with periodic interpolation' 244 215 WRITE (numout,*) ' we take the last value for the last period ' … … 249 220 ENDIF 250 221 ! 251 ! We have to prepare a new read of data : swap from record 2 to 1 252 ! 253 CALL swap_dyn_data 254 255 iswap = 1 ! indicates swap 256 222 CALL swap_dyn_data ! We have to prepare a new read of data : swap from record 2 to 1 223 ! 224 iswap = 1 ! indicates swap 225 ! 257 226 CALL dynrea( kt, iper ) ! data read for the iper period 258 227 ! 259 228 IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN 260 229 ! Computes slopes. Caution : here tsn and avt are used as workspace 261 tsn (:,:,:,jp_tem) = tdta (:,:,:,2) 262 tsn (:,:,:,jp_sal) = sdta (:,:,:,2) 263 avt(:,:,:) = avtdta(:,:,:,2) 264 265 CALL eos( tsn, rhd, rhop ) ! Time-filtered in situ density 266 CALL bn2( tsn, rn2 ) ! before Brunt-Vaisala frequency 267 IF( ln_zps ) & 268 & CALL zps_hde( kt, jpts, tsn, gtsu, gtsv, & ! Partial steps: before Horizontal DErivative 269 & rhd, gru , grv ) ! of t, s, rd at the bottom ocean level 270 CALL zdf_mxl( kt ) ! mixed layer depth 271 CALL ldf_slp( kt, rhd, rn2 ) 272 230 tsn(:,:,:,jp_tem) = tdta (:,:,:,2) 231 tsn(:,:,:,jp_sal) = sdta (:,:,:,2) 232 avt(:,:,:) = avtdta(:,:,:,2) 233 ! 234 CALL eos( tsn, rhd, rhop ) ! now in situ density 235 CALL bn2( tsn, rn2 ) ! now Brunt-Vaisala frequency 236 IF( ln_zps ) CALL zps_hde( kt, jpts, tsn, gtsu, gtsv, & ! Partial steps: before Horizontal DErivative 237 & rhd, gru , grv ) ! of t, s, rd at the bottom ocean level 238 CALL zdf_mxl( kt ) ! mixed layer depth 239 CALL ldf_slp( kt, rhd, rn2 ) ! slope of iso-neutral surfaces 240 ! 273 241 uslpdta (:,:,:,2) = uslp (:,:,:) 274 242 vslpdta (:,:,:,2) = vslp (:,:,:) … … 276 244 wslpjdta(:,:,:,2) = wslpj(:,:,:) 277 245 END IF 278 279 ! store the information of the period read 280 ndyn1 = ndyn2 246 ! 247 ndyn1 = ndyn2 ! store the information of the period read 281 248 ndyn2 = iper 282 283 IF 284 WRITE (numout,*) ' dynamics data read for the period ndyn1 =', ndyn1,&285 & ' and for the period ndyn2 = ', ndyn2249 ! 250 IF(lwp) THEN 251 WRITE (numout,*) ' dynamics data read for the period ndyn1 =', ndyn1, & 252 & ' and for the period ndyn2 = ', ndyn2 286 253 WRITE (numout,*) ' time step is : ', kt 287 254 END IF … … 292 259 !---------------------------------------- 293 260 294 IF( nsptint == 0 ) THEN 295 ! No spatial interpolation, data are probably correct 296 ! We have to initialize data if we have changed the period 297 CALL assign_dyn_data 298 ELSE IF( nsptint == 1 ) THEN 299 ! linear interpolation 261 IF( nsptint == 0 ) THEN ! No space interpolation, data are probably correct 262 ! ! We have to initialize data if we have changed the period 263 CALL assign_dyn_data 264 ELSEIF( nsptint == 1 ) THEN ! linear interpolation 300 265 CALL linear_interp_dyn_data( zweigh ) 301 ELSE 302 ! other interpolation 266 ELSE ! other interpolation 303 267 WRITE (numout,*) ' this kind of interpolation do not exist at the moment : we stop' 304 268 STOP 'dtadyn' 305 269 END IF 306 307 ! In any case, we need rhop 308 CALL eos( tsn, rhd, rhop ) 309 270 ! 271 CALL eos( tsn, rhd, rhop ) ! In any case, we need rhop 272 ! 310 273 #if ! defined key_degrad && defined key_traldf_c2d 311 ! In case of 2D varying coefficients, we need aeiv and aeiu274 ! ! In case of 2D varying coefficients, we need aeiv and aeiu 312 275 IF( lk_traldf_eiv ) CALL dta_eiv( kt ) ! eddy induced velocity coefficient 313 276 #endif 314 315 ! Compute bbl coefficients if needed 316 IF( lk_trabbl .AND. .NOT. lk_c1d ) THEN 277 ! 278 IF( lk_trabbl .AND. .NOT. lk_c1d ) THEN ! Compute bbl coefficients if needed 317 279 tsb(:,:,:,:) = tsn(:,:,:,:) 318 280 CALL bbl( kt, 'TRC') 319 281 END IF 320 282 ! 321 283 END SUBROUTINE dta_dyn 284 322 285 323 286 SUBROUTINE dynrea( kt, kenr ) … … 327 290 !! ** Purpose : READ dynamics fiels from OPA9 netcdf output 328 291 !! 329 !! ** Method : READ the kenr records of DATA and store in 330 !! in udta(...,2), .... 331 !! 332 !! ** History : additions : M. Levy et M. Benjelloul jan 2001 333 !! (netcdf FORMAT) 334 !! 05-03 (O. Aumont and A. El Moussaoui) F90 335 !! 06-07 : (C. Ethe) use of iom module 336 !!---------------------------------------------------------------------- 337 !! * Modules used 338 USE iom 339 340 !! * Arguments 341 INTEGER, INTENT( in ) :: kt, kenr ! time index 342 !! * Local declarations 292 !! ** Method : READ the kenr records of DATA and store in udta(...,2), .... 293 !!---------------------------------------------------------------------- 294 INTEGER, INTENT(in) :: kt, kenr ! time index 295 !! 343 296 INTEGER :: jkenr 344 345 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 346 zu, zv, zw, zt, zs, zavt , & ! 3-D dynamical fields 347 zhdiv ! horizontal divergence 348 349 REAL(wp), DIMENSION(jpi,jpj) :: & 350 zemp, zqsr, zmld, zice, zwspd, & 351 ztaux, ztauy 352 297 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zu, zv, zw, zt, zs, zavt , zhdiv ! 3D workspace 298 REAL(wp), DIMENSION(jpi,jpj) :: zemp, zqsr, zmld, zice, zwspd, ztaux, ztauy ! 2D workspace 353 299 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 354 300 REAL(wp), DIMENSION(jpi,jpj) :: zaeiw 355 301 #endif 356 357 302 #if defined key_degrad 358 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 359 zahtu, zahtv, zahtw ! Lateral diffusivity 303 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zahtu, zahtv, zahtw ! Lateral diffusivity 360 304 # if defined key_traldf_eiv 361 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 362 zaeiu, zaeiv, zaeiw ! G&M coefficient 305 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zaeiu, zaeiv, zaeiw ! G&M coefficient 363 306 # endif 364 307 #endif 365 366 !--------------------------------------------------------------- 308 !!---------------------------------------------------------------------- 309 367 310 ! 0. Initialization 368 311 … … 374 317 IF(lwp) THEN 375 318 WRITE(numout,*) 376 WRITE(numout,*) 'Dynrea : read ingdynamical fields, kenr = ', jkenr377 WRITE(numout,*) ' 319 WRITE(numout,*) 'Dynrea : read dynamical fields, kenr = ', jkenr 320 WRITE(numout,*) '~~~~~~~' 378 321 #if defined key_degrad 379 322 WRITE(numout,*) ' Degraded fields' … … 415 358 CALL wzv( zu, zv, zw, zhdiv ) 416 359 417 # if defined key_zdfddm 418 CALL iom_get( numfl_w, jpdom_data, 'voddmavs', zavt (:,:,:), jkenr )419 #else 420 CALL iom_get( numfl_w, jpdom_data, 'votkeavt', zavt (:,:,:), jkenr )421 #endif 360 IF( iom_varid( numfl_w, 'voddmavs', ldstop = .FALSE. ) > 0 ) THEN ! avs exist: it is used 361 CALL iom_get( numfl_w, jpdom_data, 'voddmavs', zavt (:,:,:), jkenr ) 362 ELSE ! no avs: use avt 363 CALL iom_get( numfl_w, jpdom_data, 'votkeavt', zavt (:,:,:), jkenr ) 364 ENDIF 422 365 423 366 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv … … 473 416 CALL iom_close ( numfl_w ) 474 417 ENDIF 475 418 ! 476 419 END SUBROUTINE dynrea 477 420 421 478 422 SUBROUTINE dta_dyn_init 479 423 !!---------------------------------------------------------------------- … … 483 427 !! 484 428 !! ** Method : 485 !! 486 !! History : 487 !! ! original : 92-01 (M. Imbard: sub domain) 488 !! ! 98-04 (L.Bopp MA Foujols: slopes for isopyc.) 489 !! ! 98-05 (L. Bopp read output of coupled run) 490 !! ! 05-03 (O. Aumont and A. El Moussaoui) F90 491 !!---------------------------------------------------------------------- 492 !! * Modules used 493 494 !! * Local declarations 495 429 !!---------------------------------------------------------------------- 496 430 REAL(wp) :: znspyr !: number of time step per year 497 431 !! 498 432 NAMELIST/namdyn/ ndtadyn, ndtatot, nsptint, lperdyn, & 499 433 & cfile_grid_T, cfile_grid_U, cfile_grid_V, cfile_grid_W … … 503 437 ! ====================================== 504 438 505 ! Read Namelist namdyn : Lateral physics on tracers 506 REWIND( numnam ) 439 REWIND( numnam ) ! Read Namelist namdyn : Lateral physics on tracers 507 440 READ ( numnam, namdyn ) 508 441 509 IF(lwp) THEN 442 IF(lwp) THEN ! control print 510 443 WRITE(numout,*) 511 444 WRITE(numout,*) 'namdyn : offline dynamical selection' … … 524 457 WRITE(numout,*) ' ' 525 458 ENDIF 526 459 ! 527 460 znspyr = nyear_len(1) * rday / rdt 528 461 rnspdta = znspyr / FLOAT( ndtadyn ) 529 462 rnspdta2 = rnspdta * 0.5 530 463 ! 531 464 CALL dta_dyn( nit000 ) 532 465 ! 533 466 END SUBROUTINE dta_dyn_init 534 467 468 535 469 SUBROUTINE wzv( pu, pv, pw, phdiv ) 536 470 !!---------------------------------------------------------------------- … … 539 473 !! ** Purpose : Compute the now vertical velocity after the array swap 540 474 !! 541 !! ** Method : 542 !! ** Method : - Divergence: 543 !! - compute the now divergence given by : 544 !! * z-coordinate 475 !! ** Method : - compute the now divergence given by : 476 !! * z-coordinate ONLY !!!! 545 477 !! hdiv = 1/(e1t*e2t) [ di(e2u u) + dj(e1v v) ] 546 478 !! - Using the incompressibility hypothesis, the vertical 547 479 !! velocity is computed by integrating the horizontal divergence 548 480 !! from the bottom to the surface. 549 !! The boundary conditions are w=0 at the bottom (no flux) and, 550 !! in regid-lid case, w=0 at the sea surface. 551 !! 552 !! 553 !! History : 554 !! 9.0 ! 02-07 (G. Madec) Vector optimization 555 !!---------------------------------------------------------------------- 556 !! * Arguments 557 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pu, pv !: horizontal velocities 558 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) :: pw !: verticla velocity 559 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: phdiv !: horizontal divergence 560 561 !! * Local declarations 481 !! The boundary conditions are w=0 at the bottom (no flux). 482 !!---------------------------------------------------------------------- 483 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu, pv !: horizontal velocities 484 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: pw !: verticla velocity 485 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phdiv !: horizontal divergence 486 !! 562 487 INTEGER :: ji, jj, jk 563 488 REAL(wp) :: zu, zu1, zv, zv1, zet 564 565 489 !!---------------------------------------------------------------------- 490 ! 566 491 ! Computation of vertical velocity using horizontal divergence 567 492 phdiv(:,:,:) = 0. … … 577 502 END DO 578 503 END DO 579 ENDDO 580 581 ! Lateral boundary conditions on phdiv 582 CALL lbc_lnk( phdiv, 'T', 1. ) 583 584 504 END DO 505 CALL lbc_lnk( phdiv, 'T', 1. ) ! Lateral boundary conditions on phdiv 506 ! 585 507 ! computation of vertical velocity from the bottom 586 pw(:,:,jpk) = 0. 508 pw(:,:,jpk) = 0._wp 587 509 DO jk = jpkm1, 1, -1 588 510 pw(:,:,jk) = pw(:,:,jk+1) - fse3t(:,:,jk) * phdiv(:,:,jk) 589 511 END DO 590 512 ! 591 513 END SUBROUTINE wzv 514 592 515 593 516 SUBROUTINE dta_eiv( kt ) … … 600 523 !! ** Method : Specific to the offline model. Computes the horizontal 601 524 !! values from the vertical value 602 !! 603 !! History : 604 !! 9.0 ! 06-03 (O. Aumont) Free form, F90 605 !!---------------------------------------------------------------------- 606 !! * Arguments 525 !!---------------------------------------------------------------------- 607 526 INTEGER, INTENT( in ) :: kt ! ocean time-step inedx 608 609 !! * Local declarations 527 !! 610 528 INTEGER :: ji, jj ! dummy loop indices 611 529 !!---------------------------------------------------------------------- 612 530 ! 613 531 IF( kt == nit000 ) THEN 614 532 IF(lwp) WRITE(numout,*) … … 616 534 IF(lwp) WRITE(numout,*) '~~~~~~~' 617 535 ENDIF 618 536 ! 619 537 ! Average the diffusive coefficient at u- v- points 620 538 DO jj = 2, jpjm1 … … 624 542 END DO 625 543 END DO 626 627 ! lateral boundary condition on aeiu, aeiv 628 CALL lbc_lnk( aeiu, 'U', 1. ) 629 CALL lbc_lnk( aeiv, 'V', 1. ) 630 544 CALL lbc_lnk( aeiu, 'U', 1. ) ; CALL lbc_lnk( aeiv, 'V', 1. ) ! lateral boundary condition 545 ! 631 546 END SUBROUTINE dta_eiv 547 632 548 633 549 SUBROUTINE tau2wnd( ptaux, ptauy, pwspd ) … … 639 555 !! ** Method : |tau|=rhoa*Cd*|U|^2 640 556 !!--------------------------------------------------------------------- 641 !! * Arguments 642 REAL(wp), DIMENSION(jpi,jpj), INTENT( in ) :: & 643 ptaux, ptauy !: wind stress in i-j direction resp. 644 REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) :: & 645 pwspd !: wind speed 646 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 647 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 648 REAL(wp) :: ztx, zty, ztau, zcoef ! temporary variables 649 INTEGER :: ji, jj ! dummy indices 557 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: ptaux, ptauy ! wind stress in i-j direction resp. 558 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pwspd ! wind speed 559 !! 560 REAL(wp) :: zrhoa = 1.22_wp ! Air density kg/m3 561 REAL(wp) :: zcdrag = 1.5e-3_wp ! drag coefficient 562 REAL(wp) :: ztx, zty, ztau, zcoef ! temporary variables 563 INTEGER :: ji, jj ! dummy indices 650 564 !!--------------------------------------------------------------------- 651 565 zcoef = 1. / ( zrhoa * zcdrag ) … … 661 575 END DO 662 576 CALL lbc_lnk( pwspd(:,:), 'T', 1. ) 663 577 ! 664 578 END SUBROUTINE tau2wnd 665 579 580 666 581 SUBROUTINE swap_dyn_data 667 582 !!---------------------------------------------------------------------- … … 669 584 !! 670 585 !! ** Purpose : swap array data 671 !! 672 !! History : 673 !! 9.0 ! 07-09 (C. Ethe) 674 !!---------------------------------------------------------------------- 675 676 586 !!---------------------------------------------------------------------- 587 ! 677 588 ! swap from record 2 to 1 678 589 tdta (:,:,:,1) = tdta (:,:,:,2) … … 709 620 # endif 710 621 #endif 711 622 ! 712 623 END SUBROUTINE swap_dyn_data 624 713 625 714 626 SUBROUTINE assign_dyn_data … … 728 640 vn (:,:,:) = vdta (:,:,:,2) 729 641 wn (:,:,:) = wdta (:,:,:,2) 730 731 #if defined key_zdfddm732 avs(:,:,:) = avtdta (:,:,:,2)733 #endif734 735 642 736 643 #if defined key_ldfslp && ! defined key_c1d … … 761 668 aeiw(:,:,:) = aeiwdta(:,:,:,2) 762 669 # endif 763 764 #endif 765 670 #endif 671 ! 766 672 END SUBROUTINE assign_dyn_data 767 673 674 768 675 SUBROUTINE linear_interp_dyn_data( pweigh ) 769 676 !!---------------------------------------------------------------------- 770 !! 677 !! *** ROUTINE linear_interp_dyn_data *** 771 678 !! 772 679 !! ** Purpose : linear interpolation of data 773 !! 774 !!---------------------------------------------------------------------- 775 !! * Argument 776 REAL(wp), INTENT( in ) :: pweigh ! weigh 777 778 !! * Local declarations 680 !!---------------------------------------------------------------------- 681 REAL(wp), INTENT(in) :: pweigh ! weigh 682 !! 779 683 REAL(wp) :: zweighm1 780 684 !!---------------------------------------------------------------------- … … 789 693 vn (:,:,:) = zweighm1 * vdta (:,:,:,1) + pweigh * vdta (:,:,:,2) 790 694 wn (:,:,:) = zweighm1 * wdta (:,:,:,1) + pweigh * wdta (:,:,:,2) 791 792 #if defined key_zdfddm793 avs(:,:,:) = zweighm1 * avtdta (:,:,:,1) + pweigh * avtdta (:,:,:,2)794 #endif795 796 695 797 696 #if defined key_ldfslp && ! defined key_c1d … … 823 722 # endif 824 723 #endif 825 724 ! 826 725 END SUBROUTINE linear_interp_dyn_data 827 726 727 !!====================================================================== 828 728 END MODULE dtadyn -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OFF_SRC/istate.F90
r2287 r2444 2 2 !!====================================================================== 3 3 !! *** MODULE istate *** 4 !! Ocean state : initial state setting 4 !! Ocean state : initial state setting, off-line case 5 5 !!===================================================================== 6 !! History : 3.3 ! 2010-10 (C. Ethe) original code 7 !!---------------------------------------------------------------------- 6 8 7 9 !!---------------------------------------------------------------------- 8 !! istate_init : initial state set ting10 !! istate_init : initial state set to zero 9 11 !!---------------------------------------------------------------------- 10 !! * Modules used11 12 USE oce ! ocean dynamics and active tracers 12 13 USE dom_oce ! ocean space and time domain 13 USE ldftra_oce ! ocean active tracers: lateral physics14 USE zdf_oce ! ocean vertical physics15 USE in_out_manager ! I/O manager16 USE phycst ! physical constants17 14 18 15 IMPLICIT NONE 19 16 PRIVATE 20 17 21 !! * Routine accessibility 22 PUBLIC istate_init ! routine called by step.F90 18 PUBLIC istate_init ! routine called by step.F90 23 19 24 20 !! * Substitutions … … 28 24 !! NEMO/OFF 3.3 , NEMO Consortium (2010) 29 25 !! $Id$ 30 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 31 !!---------------------------------------------------------------------- 32 26 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 27 !!--------------------------------------------------------------------- 33 28 CONTAINS 34 29 … … 37 32 !! *** ROUTINE istate_init *** 38 33 !! 39 !! ** Purpose : Initialization of the dynamics and tracers. 40 !! 41 !! ** Method : 42 !! 43 !! History : 44 !! 4.0 ! 91-03 () Original code 45 !! ! 91-11 (G. Madec) 46 !! 9.0 ! 03-09 (G. Madec) F90: Free form, modules, orthogonality 34 !! ** Purpose : Initialization to zero of the dynamics and tracers. 47 35 !!---------------------------------------------------------------------- 48 !! * Local declarations 49 !!---------------------------------------------------------------------- 50 51 52 ! Initialization to zero 53 ! ---------------------- 54 55 ! before fields ! now fields ! after fields ! 56 ; un (:,:,:) = 0.e0 ; ua (:,:,:) = 0.e0 57 ; vn (:,:,:) = 0.e0 ; va (:,:,:) = 0.e0 58 ; ; wn (:,:,:) = 0.e0 59 ; hdivn(:,:,:) = 0.e0 ; 60 61 ; tsn (:,:,:,:) = 0.e0 62 36 ! 37 ! now fields ! after fields ! 38 un (:,:,:) = 0._wp ; ua(:,:,:) = 0._wp ! 39 vn (:,:,:) = 0._wp ; va(:,:,:) = 0._wp ! 40 wn (:,:,:) = 0._wp ! ! 41 hdivn(:,:,:) = 0._wp ! ! 42 tsn (:,:,:,:) = 0._wp ! ! 43 ! 63 44 rhd (:,:,:) = 0.e0 64 45 rhop (:,:,:) = 0.e0 65 46 rn2 (:,:,:) = 0.e0 66 67 47 ! 68 48 END SUBROUTINE istate_init 69 49 -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OFF_SRC/opa.F90
r2431 r2444 1 1 MODULE opa 2 !!====================================================================== ========2 !!====================================================================== 3 3 !! *** MODULE opa *** 4 !! Ocean system : OPA ocean dynamics (including on-line tracers and sea-ice) 5 !!============================================================================== 6 7 !!---------------------------------------------------------------------- 8 !! opa_model : solve ocean dynamics, tracer and/or sea-ice 9 !!---------------------------------------------------------------------- 10 !! * Modules used 4 !! Off-line Ocean : passive tracer evolution, dynamics read in files 5 !!====================================================================== 6 !! History : 3.3 ! 2010-05 (C. Ethe) Full reorganization of the off-line: phasing with the on-line 7 !!---------------------------------------------------------------------- 8 9 !!---------------------------------------------------------------------- 10 !! opa_model : off-line: solve ocean tracer only 11 !! opa_init : initialization of the opa model 12 !! opa_ctl : initialisation of algorithm flag 13 !! opa_closefile : close remaining files 14 !!---------------------------------------------------------------------- 11 15 USE dom_oce ! ocean space domain variables 12 16 USE oce ! dynamics and tracers variables 13 USE in_out_manager ! I/O manager 14 USE lib_mpp ! distributed memory computing 15 17 USE c1d ! 1D configuration 16 18 USE domcfg ! domain configuration (dom_cfg routine) 17 USE mppini ! shared/distributed memory setting (mpp_init routine)18 19 USE domain ! domain initialization (dom_init routine) 19 20 USE istate ! initial state setting (istate_init routine) 20 21 USE eosbn2 ! equation of state (eos bn2 routine) 21 22 ! ocean physics 22 ! ! ocean physics 23 23 USE ldftra ! lateral diffusivity setting (ldf_tra_init routine) 24 24 USE ldfslp ! slopes of neutral surfaces (ldf_slp_init routine) … … 26 26 USE trabbl ! bottom boundary layer (tra_bbl_init routine) 27 27 USE zpshde ! partial step: hor. derivative (zps_hde_init routine) 28 USE zdfini 29 USE zdfddm 30 USE zdfkpp 31 28 USE zdfini ! vertical physics: initialization 32 29 USE phycst ! physical constant (par_cst routine) 33 30 USE dtadyn ! Lecture and Interpolation of the dynamical fields 34 31 USE trcini ! Initilization of the passive tracers 35 USE stpctl36 32 USE daymod ! calendar (day routine) 37 33 USE trcstp ! passive tracer time-stepping (trc_stp routine) 38 34 USE dtadyn ! Lecture and interpolation of the dynamical fields 39 35 USE stpctl ! time stepping control (stp_ctl routine) 40 41 USE c1d ! 1D configuration 42 43 USE iom 36 ! ! I/O & MPP 37 USE iom ! I/O library 38 USE in_out_manager ! I/O manager 39 USE mppini ! shared/distributed memory setting (mpp_init routine) 40 USE lib_mpp ! distributed memory computing 44 41 #if defined key_iomput 45 42 USE mod_ioclient … … 48 45 IMPLICIT NONE 49 46 PRIVATE 50 51 !! * Module variables 52 CHARACTER (len=64) :: & 53 cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing 54 55 !! * Routine accessibility 56 PUBLIC opa_model ! called by model.F90 57 PUBLIC opa_init 47 48 PUBLIC opa_model ! called by model.F90 49 50 CHARACTER (len=64) :: cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing 51 58 52 !!---------------------------------------------------------------------- 59 53 !! NEMO/OFF 3.3 , NEMO Consortium (2010) 60 54 !! $Id$ 61 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 62 !!---------------------------------------------------------------------- 63 55 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 56 !!---------------------------------------------------------------------- 64 57 CONTAINS 65 58 … … 72 65 !! 73 66 !! ** Method : - model general initialization 74 !! - launch the time-stepping ( stp routine)75 !! 76 !! References :77 !! Madec, Delecluse,Imbard, and Levy, 1997: reference manual.78 !! internal report, IPSL.67 !! - launch the time-stepping (dta_dyn and trc_stp) 68 !! - finalize the run by closing files and communications 69 !! 70 !! References : Madec, Delecluse,Imbard, and Levy, 1997: internal report, IPSL. 71 !! Madec, 2008, internal report, IPSL. 79 72 !!---------------------------------------------------------------------- 80 73 INTEGER :: istp, indic ! time step index … … 89 82 IF( lk_mpp ) CALL mpp_max( nstop ) 90 83 84 ! !-----------------------! 85 ! !== time stepping ==! 86 ! !-----------------------! 91 87 istp = nit000 92 88 ! 93 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 94 ! 95 IF( istp /= nit000 ) CALL day ( istp ) ! Calendar (day was already called at nit000 in day_init)96 CALL iom_setkt( istp ) ! say to iom that we are at time step kstp97 CALL dta_dyn ( istp ) ! Interpolation of the dynamical fields98 CALL trc_stp ( istp ) ! time-stepping99 CALL stp_ctl ( istp, indic ) 89 DO WHILE ( istp <= nitend .AND. nstop == 0 ) ! time stepping 90 ! 91 IF( istp /= nit000 ) CALL day ( istp ) ! Calendar (day was already called at nit000 in day_init) 92 CALL iom_setkt( istp ) ! say to iom that we are at time step kstp 93 CALL dta_dyn ( istp ) ! Interpolation of the dynamical fields 94 CALL trc_stp ( istp ) ! time-stepping 95 CALL stp_ctl ( istp, indic ) ! Time loop: control and print 100 96 istp = istp + 1 101 97 IF( lk_mpp ) CALL mpp_max( nstop ) 102 98 END DO 103 ! ! ========= ! 104 ! ! Job end!105 ! ! =========!106 107 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA99 100 ! !------------------------! 101 ! !== finalize the run ==! 102 ! !------------------------! 103 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 108 104 109 105 IF( nstop /= 0 .AND. lwp ) THEN ! error print … … 111 107 WRITE(numout,*) nstop, ' error have been found' 112 108 ENDIF 113 109 ! 114 110 CALL opa_closefile 115 111 ! 116 112 IF( lk_mpp ) CALL mppstop ! Close all files (mpp) 117 113 ! … … 123 119 !! *** ROUTINE opa_init *** 124 120 !! 125 !! ** Purpose : opa solves the primitive equations on an orthogonal 126 !! curvilinear mesh on the sphere. 127 !! 128 !! ** Method : - model general initialization 129 !! 130 !! References : 131 !! Madec, Delecluse,Imbard, and Levy, 1997: reference manual. 132 !! internal report, IPSL. 133 !! 134 !! History : 135 !! 4.0 ! 90-10 (C. Levy, G. Madec) Original code 136 !! 7.0 ! 91-11 (M. Imbard, C. Levy, G. Madec) 137 !! 7.1 ! 93-03 (M. Imbard, C. Levy, G. Madec, O. Marti, 138 !! M. Guyon, A. Lazar, P. Delecluse, C. Perigaud, 139 !! G. Caniaux, B. Colot, C. Maes ) release 7.1 140 !! ! 92-06 (L.Terray) coupling implementation 141 !! ! 93-11 (M.A. Filiberti) IGLOO sea-ice 142 !! 8.0 ! 96-03 (M. Imbard, C. Levy, G. Madec, O. Marti, 143 !! M. Guyon, A. Lazar, P. Delecluse, L.Terray, 144 !! M.A. Filiberti, J. Vialar, A.M. Treguier, 145 !! M. Levy) release 8.0 146 !! 8.1 ! 97-06 (M. Imbard, G. Madec) 147 !! 8.2 ! 99-11 (M. Imbard, H. Goosse) LIM sea-ice model 148 !! ! 99-12 (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols) OPEN-MP 149 !! ! 00-07 (J-M Molines, M. Imbard) Open Boundary Conditions (CLIPPER) 150 !! 9.0 ! 02-08 (G. Madec) F90: Free form and modules 151 !!---------------------------------------------------------------------- 152 !! * Local declarations 153 #if defined key_oasis3 || defined key_oasis4 || defined key_iomput 154 INTEGER :: ilocal_comm 155 #endif 156 CHARACTER(len=80),dimension(10) :: cltxt = '' 157 INTEGER :: ji ! local loop indices 121 !! ** Purpose : initialization of the opa model in off-line mode 122 !!---------------------------------------------------------------------- 123 INTEGER :: ji ! dummy loop indices 124 INTEGER :: ilocal_comm ! local integer 125 CHARACTER(len=80), DIMENSION(10) :: cltxt = '' 158 126 !! 159 127 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 160 128 & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, nn_bench 161 129 !!---------------------------------------------------------------------- 162 163 130 ! 164 131 ! ! open Namelist file … … 171 138 ! !--------------------------------------------! 172 139 #if defined key_iomput 173 # if defined key_oasis3 || defined key_oasis4174 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis175 CALL init_ioclient() ! io_server will get its communicators (if needed) from oasis (we don't see it)176 # else177 140 CALL init_ioclient( ilocal_comm ) ! nemo local communicator (used or not) given by the io_server 178 # endif179 141 narea = mynode( cltxt, ilocal_comm ) ! Nodes selection 180 181 142 #else 182 # if defined key_oasis3 || defined key_oasis4183 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis184 narea = mynode( cltxt, ilocal_comm ) ! Nodes selection (control print return in cltxt)185 # else186 143 narea = mynode( cltxt ) ! Nodes selection (control print return in cltxt) 187 # endif188 144 #endif 189 145 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) … … 199 155 WRITE(numout,*) ' NEMO team' 200 156 WRITE(numout,*) ' Ocean General Circulation Model' 201 WRITE(numout,*) ' version 3. 2 (2009) '157 WRITE(numout,*) ' version 3.3 (2010) ' 202 158 WRITE(numout,*) 203 159 WRITE(numout,*) … … 208 164 ! 209 165 ENDIF 210 211 CALL opa_flg ! Control prints & Benchmark 212 213 ! ! ============================== ! 214 ! ! Model general initialization ! 215 ! ! ============================== ! 216 217 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 218 219 ! Domain decomposition 220 ! Domain decomposition 166 ! !--------------------------------! 167 ! ! Model general initialization ! 168 ! !--------------------------------! 169 170 CALL opa_ctl ! Control prints & Benchmark 171 172 ! ! Domain decomposition 221 173 IF( jpni*jpnj == jpnij ) THEN ; CALL mpp_init ! standard cutting out 222 174 ELSE ; CALL mpp_init2 ! eliminate land processors 223 175 ENDIF 224 225 226 227 ! ! General initialization 176 ! 177 ! ! General initialization 228 178 CALL phy_cst ! Physical constants 229 179 CALL eos_init ! Equation of state … … 235 185 236 186 ! ! Ocean physics 237 IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) &238 & CALL zdf_ddm_init ! double diffusive mixing239 187 #if ! defined key_degrad 240 188 CALL ldf_tra_init ! Lateral ocean tracer physics … … 253 201 254 202 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 255 203 ! 256 204 END SUBROUTINE opa_init 257 205 258 SUBROUTINE opa_flg 259 !!---------------------------------------------------------------------- 260 !! *** ROUTINE opa *** 261 !! 262 !! ** Purpose : Initialise logical flags that control the choice of 263 !! some algorithm or control print 264 !! 265 !! ** Method : - print namctl information 266 !! - Read in namilist namflg logical flags 267 !!---------------------------------------------------------------------- 268 269 IF(lwp) THEN ! Parameter print 206 207 SUBROUTINE opa_ctl 208 !!---------------------------------------------------------------------- 209 !! *** ROUTINE opa_ctl *** 210 !! 211 !! ** Purpose : control print setting 212 !! 213 !! ** Method : - print namctl information and check some consistencies 214 !!---------------------------------------------------------------------- 215 ! 216 IF(lwp) THEN ! Parameter print 270 217 WRITE(numout,*) 271 218 WRITE(numout,*) 'opa_flg: Control prints & Benchmark' … … 282 229 WRITE(numout,*) ' benchmark parameter (0/1) nn_bench = ', nn_bench 283 230 ENDIF 284 231 ! 285 232 nprint = nn_print ! convert DOCTOR namelist names into OLD names 286 233 nictls = nn_ictls … … 291 238 jsplt = nn_jsplt 292 239 nbench = nn_bench 293 ! ! Parameter control240 ! ! Parameter control 294 241 ! 295 242 IF( ln_ctl ) THEN ! sub-domain area indices for the control prints … … 329 276 ENDIF 330 277 ENDIF 331 278 ! 332 279 IF( nbench == 1 ) THEN ! Benchmark 333 280 SELECT CASE ( cp_cfg ) … … 338 285 ENDIF 339 286 ! 340 IF( lk_c1d .AND. .NOT. lk_iomput )&341 CALL ctl_stop( ' The 1D vertical configuration must be used in conjunction', &342 & ' with the IOM Input/Output manager.Compile with key_iomput enabled' )343 ! 344 345 END SUBROUTINE opa_flg 287 IF( lk_c1d .AND. .NOT.lk_iomput ) CALL ctl_stop( 'opa_ctl: The 1D configuration must be used ', & 288 & 'with the IOM Input/Output manager. ' , & 289 & 'Compile with key_iomput enabled' ) 290 ! 291 END SUBROUTINE opa_ctl 292 346 293 347 294 SUBROUTINE opa_closefile … … 350 297 !! 351 298 !! ** Purpose : Close the files 352 !! 353 !! ** Method : 354 !! 355 !! History : 356 !! 9.0 ! 05-01 (O. Le Galloudec) Original code 357 !!---------------------------------------------------------------------- 358 !!---------------------------------------------------------------------- 359 299 !!---------------------------------------------------------------------- 300 ! 360 301 IF ( lk_mpp ) CALL mppsync 361 362 ! 1. Unit close 363 ! ------------- 364 365 CLOSE( numnam ) ! namelist 366 CLOSE( numout ) ! standard model output file 367 368 IF(lwp) CLOSE( numstp ) ! time-step file 369 370 CALL iom_close ! close all input/output files 371 302 ! 303 CALL iom_close ! close all input/output files managed by iom_* 304 ! 305 IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file 306 IF( numnam /= -1 ) CLOSE( numnam ) ! oce namelist 307 IF( numout /= 6 ) CLOSE( numout ) ! standard model output file 308 numout = 6 ! redefine numout in case it is used after this point... 309 ! 372 310 END SUBROUTINE opa_closefile 373 311 -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OFF_SRC/stpctl.F90
r2287 r2444 2 2 !!====================================================================== 3 3 !! *** MODULE stpctl *** 4 !! Ocean run control : gross check of the ocean time stepping4 !! Ocean run control : Off-line case, only save the time step in numstp 5 5 !!====================================================================== 6 6 !! History : OPA ! 1991-03 (G. Madec) Original code … … 23 23 PRIVATE 24 24 25 PUBLIC stp_ctl ! routine called by step.F90 25 PUBLIC stp_ctl ! routine called by opa.F90 26 26 27 !!---------------------------------------------------------------------- 27 28 !! NEMO/OFF 3.3 , NEMO Consortium (2010) 28 29 !! $Id$ 29 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)30 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 30 31 !!---------------------------------------------------------------------- 31 32 32 CONTAINS 33 33 … … 39 39 !! 40 40 !! ** Method : - Save the time step in numstp 41 !! - Print it each 50 time steps42 41 !! 43 42 !! ** Actions : 'time.step' file containing the last ocean time-step 44 !!45 43 !!---------------------------------------------------------------------- 46 INTEGER, INTENT( in ) :: kt! ocean time-step index47 INTEGER, INTENT( inout) :: kindic ! indicator of solver convergence44 INTEGER, INTENT(in ) :: kt ! ocean time-step index 45 INTEGER, INTENT(inout) :: kindic ! indicator of solver convergence 48 46 !!---------------------------------------------------------------------- 49 47 ! 50 48 IF( kt == nit000 .AND. lwp ) THEN 51 49 WRITE(numout,*) … … 55 53 CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 56 54 ENDIF 57 55 ! 58 56 IF(lwp) WRITE ( numstp, '(1x, i8)' ) kt !* save the current time step in numstp 59 57 IF(lwp) REWIND( numstp ) ! -------------------------- 60 61 58 ! 62 59 END SUBROUTINE stp_ctl
Note: See TracChangeset
for help on using the changeset viewer.