Changeset 2007 for branches/DEV_r1879_FCM/NEMOGCM
- Timestamp:
- 2010-07-13T17:14:39+02:00 (14 years ago)
- Location:
- branches/DEV_r1879_FCM/NEMOGCM/NEMO
- Files:
-
- 85 edited
- 5 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r1879_FCM/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90
r1694 r2007 66 66 ENDIF 67 67 68 IF( jphgr_msh == 2 .OR. jphgr_msh == 3 .OR. jphgr_msh == 5 ) & 69 & CALL ctl_stop(' Coriolis parameter in LIM not set for f- or beta-plane' ) 70 68 71 !---------------------------------------------------------- 69 72 ! Initialization of local and some global (common) variables -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r1756 r2007 80 80 INTEGER :: ifvt, i1mfr, idfr ! some switches 81 81 INTEGER :: iflt, ial, iadv, ifral, ifrdv 82 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integers83 82 REAL(wp) :: zrdtir ! 1. / rdt_ice 84 83 REAL(wp) :: zqsr , zqns ! solar & non solar heat flux … … 109 108 sice_r(:,:) = sice 110 109 ! 111 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 112 ! ! ======================= 113 ! ! ORCA_R2 configuration 114 ! ! ======================= 115 ii0 = 145 ; ii1 = 180 ! Baltic Sea 116 ij0 = 113 ; ij1 = 130 ; soce_r(mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 117 sice_r(mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 2.e0 118 ENDIF 119 ! 120 ENDIF 110 IF( cp_cfg == "orca" ) THEN 111 ! ocean/ice salinity in the Baltic sea 112 DO jj = 1, jpj 113 DO ji = 1, jpi 114 IF( glamt(ji,jj) >= 14. .AND. glamt(ji,jj) <= 32. .AND. gphit(ji,jj) >= 54. .AND. gphit(ji,jj) <= 66. ) THEN 115 soce_r(ji,jj) = 4.e0 116 sice_r(ji,jj) = 2.e0 117 END IF 118 END DO 119 END DO 120 ! 121 END IF 122 END IF 121 123 122 124 !------------------------------------------! -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
r1758 r2007 360 360 END DO 361 361 ENDIF 362 362 363 CALL lbc_lnk( frld , 'T', 1. ) 363 364 364 365 ! Select points for lateral accretion (this occurs when heat exchange -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90
r1715 r2007 4 4 !! LIM 2.0 transport ice model : sea-ice advection/diffusion 5 5 !!====================================================================== 6 !! History : LIM ! 2000-01 (UCL) Original code 7 !! 2.0 ! 2001-05 (G. Madec, R. Hordoir) opa norm 8 !! - ! 2004-01 (G. Madec, C. Ethe) F90, mpp 9 !!---------------------------------------------------------------------- 6 10 #if defined key_lim2 7 11 !!---------------------------------------------------------------------- … … 11 15 !! lim_trp_init_2 : initialization and namelist read 12 16 !!---------------------------------------------------------------------- 13 !! * Modules used14 USE phycst15 USE dom_oce 17 USE phycst ! physical constant 18 USE sbc_oce ! ocean surface boundary condition 19 USE dom_oce ! ocean domain 16 20 USE in_out_manager ! I/O manager 17 USE dom_ice_2 18 USE ice_2 19 USE limistate_2 20 USE limadv_2 21 USE limhdf_2 22 USE lbclnk 23 USE lib_mpp 21 USE dom_ice_2 ! LIM-2 domain 22 USE ice_2 ! LIM-2 variables 23 USE limistate_2 ! LIM-2 initial state 24 USE limadv_2 ! LIM-2 advection 25 USE limhdf_2 ! LIM-2 horizontal diffusion 26 USE lbclnk ! lateral boundary conditions -- MPP exchanges 27 USE lib_mpp ! MPP library 24 28 25 29 IMPLICIT NONE 26 30 PRIVATE 27 31 28 !! * Routine accessibility 29 PUBLIC lim_trp_2 ! called by sbc_ice_lim_2 30 31 !! * Shared module variables 32 REAL(wp), PUBLIC :: & !: 33 bound = 0.e0 !: boundary condit. (0.0 no-slip, 1.0 free-slip) 34 35 !! * Module variables 32 PUBLIC lim_trp_2 ! called by sbc_ice_lim_2 33 34 REAL(wp), PUBLIC :: bound = 0.e0 !: boundary condit. (0.0 no-slip, 1.0 free-slip) 35 36 36 REAL(wp) :: & ! constant values 37 37 epsi06 = 1.e-06 , & … … 44 44 # include "vectopt_loop_substitute.h90" 45 45 !!---------------------------------------------------------------------- 46 !! LIM 2.0, UCL-LOCEAN-IPSL (2005)46 !! NEMO/LIM 3.2, UCL-LOCEAN-IPSL (2010) 47 47 !! $Id$ 48 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt48 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 49 49 !!---------------------------------------------------------------------- 50 50 … … 62 62 !! 63 63 !! ** action : 64 !!65 !! History :66 !! 1.0 ! 00-01 (LIM) Original code67 !! ! 01-05 (G. Madec, R. Hordoir) opa norm68 !! 2.0 ! 04-01 (G. Madec, C. Ethe) F90, mpp69 64 !!--------------------------------------------------------------------- 70 65 INTEGER, INTENT(in) :: kt ! number of iteration 71 72 INTEGER :: ji, jj, jk, & ! dummy loop indices 73 & initad ! number of sub-timestep for the advection 74 75 REAL(wp) :: & 76 zindb , & 77 zacrith, & 78 zindsn , & 79 zindic , & 80 zusvosn, & 81 zusvoic, & 82 zignm , & 83 zindhe , & 84 zvbord , & 85 zcfl , & 86 zusnit , & 87 zrtt, ztsn, ztic1, ztic2 88 89 REAL(wp), DIMENSION(jpi,jpj) :: & ! temporary workspace 90 zui_u , zvi_v , zsm , & 91 zs0ice, zs0sn , zs0a , & 92 zs0c0 , zs0c1 , zs0c2 , & 93 zs0st 66 !! 67 INTEGER :: ji, jj, jk ! dummy loop indices 68 INTEGER :: initad ! number of sub-timestep for the advection 69 REAL(wp) :: zindb , zindsn , zindic, zacrith ! local scalars 70 REAL(wp) :: zusvosn, zusvoic, zignm , zindhe ! - - 71 REAL(wp) :: zvbord , zcfl , zusnit ! - - 72 REAL(wp) :: zrtt , ztsn , ztic1 , ztic2 ! - - 73 REAL(wp), DIMENSION(jpi,jpj) :: zui_u , zvi_v , zsm ! 2D workspace 74 REAL(wp), DIMENSION(jpi,jpj) :: zs0ice, zs0sn , zs0a ! - - 75 REAL(wp), DIMENSION(jpi,jpj) :: zs0c0 , zs0c1 , zs0c2 , zs0st ! - - 94 76 !--------------------------------------------------------------------- 95 77 … … 105 87 ! ice velocities at ocean U- and V-points (zui_u,zvi_v) 106 88 ! --------------------------------------- 107 ! zvbord factor between 1 and 2 to take into account slip or no-slip boundary conditions. 108 zvbord = 1.0 + ( 1.0 - bound ) 89 zvbord = 1.0 + ( 1.0 - bound ) ! zvbord=2 no-slip, =0 free slip boundary conditions 109 90 DO jj = 1, jpjm1 110 91 DO ji = 1, jpim1 ! NO vector opt. … … 113 94 END DO 114 95 END DO 115 ! Lateral boundary conditions on zui_u, zvi_v 116 CALL lbc_lnk( zui_u, 'U', -1. ) 117 CALL lbc_lnk( zvi_v, 'V', -1. ) 96 CALL lbc_lnk( zui_u, 'U', -1. ) ; CALL lbc_lnk( zvi_v, 'V', -1. ) ! Lateral boundary conditions 97 118 98 119 99 ! CFL test for stability … … 122 102 zcfl = MAX( zcfl, MAXVAL( ABS( zui_u(1:jpim1, : ) ) * rdt_ice / e1u(1:jpim1, : ) ) ) 123 103 zcfl = MAX( zcfl, MAXVAL( ABS( zvi_v( : ,1:jpjm1) ) * rdt_ice / e2v( : ,1:jpjm1) ) ) 124 125 IF (lk_mpp ) CALL mpp_max(zcfl)126 127 IF ( zcfl > 0.5 .AND. lwp ) WRITE(numout,*) 'lim_trp_2 : violation of cfl criterion the ',nday,'th day, cfl = ',zcfl104 ! 105 IF(lk_mpp) CALL mpp_max( zcfl ) 106 ! 107 IF( zcfl > 0.5 .AND. lwp ) WRITE(numout,*) 'lim_trp_2 : violation of cfl criterion the ',nday,'th day, cfl = ', zcfl 128 108 129 109 ! content of properties 130 110 ! --------------------- 131 111 zs0sn (:,:) = hsnm(:,:) * area(:,:) ! Snow volume. 132 zs0ice(:,:) = hicm (:,:) * area(:,:)! Ice volume.133 zs0a (:,:) = ( 1.0 - frld(:,:) ) * area(:,:)! Surface covered by ice.134 zs0c0 (:,:) = tbif(:,:,1) / rt0_snow * zs0sn (:,:)! Heat content of the snow layer.112 zs0ice(:,:) = hicm(:,:) * area(:,:) ! Ice volume. 113 zs0a (:,:) = ( 1.0 - frld(:,:) ) * area (:,:) ! Surface covered by ice. 114 zs0c0 (:,:) = tbif(:,:,1) / rt0_snow * zs0sn (:,:) ! Heat content of the snow layer. 135 115 zs0c1 (:,:) = tbif(:,:,2) / rt0_ice * zs0ice(:,:) ! Heat content of the first ice layer. 136 116 zs0c2 (:,:) = tbif(:,:,3) / rt0_ice * zs0ice(:,:) ! Heat content of the second ice layer. 137 zs0st (:,:) = qstoif(:,:) / xlic * zs0a (:,:)! Heat reservoir for brine pockets.117 zs0st (:,:) = qstoif(:,:) / xlic * zs0a (:,:) ! Heat reservoir for brine pockets. 138 118 139 119 140 ! Advection 120 ! Advection (Prather scheme) 141 121 ! --------- 142 ! If ice drift field is too fast, use an appropriate time step for advection. 143 initad = 1 + INT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) ) 144 zusnit = 1.0 / REAL( initad ) 145 146 IF ( MOD( nday , 2 ) == 0) THEN 147 DO jk = 1,initad 122 initad = 1 + INT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) ) ! If ice drift field is too fast, 123 zusnit = 1.0 / REAL( initad ) ! split the ice time step in two 124 ! 125 IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0) THEN !== odd ice time step: adv_x then adv_y ==! 126 DO jk = 1, initad 148 127 CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice ) 149 128 CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice ) … … 161 140 CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsm, zs0st , sxst , sxxst , syst , syyst , sxyst ) 162 141 END DO 163 ELSE 142 ELSE !== even ice time step: adv_x then adv_y ==! 164 143 DO jk = 1, initad 165 144 CALL lim_adv_y_2( zusnit, zvi_v, rone , zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice ) … … 182 161 ! recover the properties from their contents 183 162 ! ------------------------------------------ 163 !!gm Define in limmsh one for all area = 1 /area (CPU time saved !) 184 164 zs0ice(:,:) = zs0ice(:,:) / area(:,:) 185 165 zs0sn (:,:) = zs0sn (:,:) / area(:,:) … … 205 185 END DO 206 186 END DO 187 !!gm more readable coding: (and avoid an error in F90 with sign of zero) 188 ! DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 189 ! DO ji = 1 , fs_jpim1 ! vector opt. 190 ! IF( MIN( zs0a(ji,jj) , zs0a(ji+1,jj) ) == 0.e0 ) pahu(ji,jj) = 0.e0 191 ! IF( MIN( zs0a(ji,jj) , zs0a(ji,jj+1) ) == 0.e0 ) pahv(ji,jj) = 0.e0 192 ! END DO 193 ! END DO 194 !!gm end 207 195 208 196 ! diffusion … … 216 204 CALL lim_hdf_2( zs0st ) 217 205 218 zs0ice(:,:) = MAX( rzero, zs0ice(:,:) * area(:,:) ) !!bug: est-ce utile 219 zs0sn (:,:) = MAX( rzero, zs0sn (:,:) * area(:,:) ) !!bug: cf /area juste apres 220 zs0a (:,:) = MAX( rzero, zs0a (:,:) * area(:,:) ) !! suppression des 2 change le resultat... 221 zs0c0 (:,:) = MAX( rzero, zs0c0 (:,:) * area(:,:) ) 206 !!gm see comment this can be skipped 207 zs0ice(:,:) = MAX( rzero, zs0ice(:,:) * area(:,:) ) !!bug: useless 208 zs0sn (:,:) = MAX( rzero, zs0sn (:,:) * area(:,:) ) !!bug: cf /area just below 209 zs0a (:,:) = MAX( rzero, zs0a (:,:) * area(:,:) ) !! caution: the suppression of the 2 changes 210 zs0c0 (:,:) = MAX( rzero, zs0c0 (:,:) * area(:,:) ) !! the last digit of the results 222 211 zs0c1 (:,:) = MAX( rzero, zs0c1 (:,:) * area(:,:) ) 223 212 zs0c2 (:,:) = MAX( rzero, zs0c2 (:,:) * area(:,:) ) … … 225 214 226 215 227 ! -------------------------------------------------------------------! 228 ! Up-dating and limitation of sea ice properties after transport ! 229 ! -------------------------------------------------------------------! 230 231 ! Up-dating and limitation of sea ice properties after transport. 216 !-------------------------------------------------------------------! 217 ! Updating and limitation of sea ice properties after transport ! 218 !-------------------------------------------------------------------! 232 219 DO jj = 1, jpj 233 !!!iii zindhe = REAL( MAX( 0, isign(1, jj - njeq ) ) ) !ibug mpp !!bugmpp njeq!234 220 zindhe = MAX( 0.e0, SIGN( 1.e0, fcor(1,jj) ) ) ! = 0 for SH, =1 for NH 235 221 DO ji = 1, jpi 236 222 ! 237 223 ! Recover mean values over the grid squares. 238 224 zs0sn (ji,jj) = MAX( rzero, zs0sn (ji,jj)/area(ji,jj) ) … … 272 258 END DO 273 259 END DO 274 260 ! 275 261 ENDIF 276 262 ! 277 263 END SUBROUTINE lim_trp_2 278 264 … … 284 270 !! ** Purpose : initialization of ice advection parameters 285 271 !! 286 !! ** Method : Read the namicetrp namelist and check the parameter287 !! values called at the first timestep (nit000)272 !! ** Method : Read the namicetrp namelist and check the parameter 273 !! values called at the first timestep (nit000) 288 274 !! 289 275 !! ** input : Namelist namicetrp 290 !!291 !! history :292 !! 2.0 ! 03-08 (C. Ethe) Original code293 276 !!------------------------------------------------------------------- 294 277 NAMELIST/namicetrp/ bound 295 278 !!------------------------------------------------------------------- 296 297 ! Read Namelist namicetrp 298 REWIND ( numnam_ice ) 279 ! 280 REWIND ( numnam_ice ) ! Read Namelist namicetrp 299 281 READ ( numnam_ice , namicetrp ) 300 282 IF(lwp) THEN … … 304 286 WRITE(numout,*) ' boundary conditions (0. no-slip, 1. free-slip) bound = ', bound 305 287 ENDIF 306 288 ! 307 289 END SUBROUTINE lim_trp_init_2 308 290 -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90
r1715 r2007 313 313 CALL histwrite( kid, "iicetemp", kt, sist(:,:) - rt0, jpi*jpj, (/1/) ) 314 314 CALL histwrite( kid, "ioceflxb", kt, fbif , jpi*jpj, (/1/) ) 315 CALL histwrite( kid, "iicevel v", kt, u_ice , jpi*jpj, (/1/) )316 CALL histwrite( kid, "iicevel u", kt, v_ice , jpi*jpj, (/1/) )315 CALL histwrite( kid, "iicevelu", kt, u_ice , jpi*jpj, (/1/) ) 316 CALL histwrite( kid, "iicevelv", kt, v_ice , jpi*jpj, (/1/) ) 317 317 CALL histwrite( kid, "isstempe", kt, sst_m , jpi*jpj, (/1/) ) 318 318 CALL histwrite( kid, "isssalin", kt, sss_m , jpi*jpj, (/1/) ) -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90
r1694 r2007 53 53 WRITE(numout,*) '~~~~~~~' 54 54 ENDIF 55 56 IF( jphgr_msh == 2 .OR. jphgr_msh == 3 .OR. jphgr_msh == 5 ) & 57 & CALL ctl_stop(' Coriolis parameter in LIM not set for f- or beta-plane' ) 55 58 56 59 ! !== coriolis factor & Equator position ==! -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r1715 r2007 204 204 zusnit = 1.0 / REAL( initad ) 205 205 206 IF ( MOD( nday , 2 ) == 0) THEN206 IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0) THEN !== odd ice time step: adv_x then adv_y ==! 207 207 DO jk = 1,initad 208 208 !--- ice open water area -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/NST_SRC/agrif2model.F90
r1156 r2007 73 73 74 74 END SUBROUTINE Agrif_clustering_def 75 76 SUBROUTINE Agrif_comm_def(modelcomm) 77 78 !!--------------------------------------------- 79 !! *** ROUTINE Agrif_clustering_def *** 80 !!--------------------------------------------- 81 Use Agrif_Types 82 Use lib_mpp 83 84 IMPLICIT NONE 85 86 INTEGER :: modelcomm 87 88 #if defined key_mpp_mpi 89 modelcomm = mpi_comm_opa 90 #endif 91 Return 92 93 END SUBROUTINE Agrif_comm_def 75 94 #else 76 95 SUBROUTINE Agrif2Model -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r1605 r2007 73 73 USE tradmp 74 74 #endif 75 #if defined key_obc || defined key_esopa 76 USE obc_par 77 #endif 75 78 USE sol_oce 76 79 USE in_out_manager … … 105 108 ! no tracer damping on fine grids 106 109 lk_tradmp = .FALSE. 110 #endif 111 #if defined key_obc || defined key_esopa 112 ! no open boundary on fine grids 113 lk_obc = .FALSE. 107 114 #endif 108 115 ! 1. Declaration of the type of variable which have to be interpolated -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OFF_SRC/DOM/domrea.F90
r1641 r2007 215 215 216 216 217 DO jk = 1,jpk218 gdept(:,:,jk) = gdept_0(jk)219 gdepw(:,:,jk) = gdepw_0(jk)220 END DO221 222 223 217 IF( ln_zps ) THEN 218 ! Vertical coordinates and scales factors 219 CALL iom_get( inum4, jpdom_unknown, 'gdept_0', gdept_0 ) ! depth 220 CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', gdepw_0 ) 221 CALL iom_get( inum4, jpdom_unknown, 'e3t_0' , e3t_0 ) 222 CALL iom_get( inum4, jpdom_unknown, 'e3w_0' , e3w_0 ) 224 223 ! z-coordinate - partial steps 225 224 IF( nmsh <= 6 ) THEN ! ! 3D vertical scale factors … … 233 232 END IF 234 233 235 IF( nmsh <= 3 ) THEN ! ! 3D depth234 IF( iom_varid( inum4, 'gdept', ldstop = .FALSE. ) > 0 ) THEN 236 235 CALL iom_get( inum4, jpdom_data, 'gdept', gdept ) ! scale factors 237 236 CALL iom_get( inum4, jpdom_data, 'gdepw', gdepw ) … … 240 239 CALL iom_get( inum4, jpdom_data, 'hdepw', hdepw ) 241 240 241 DO jk = 1,jpk 242 gdept(:,:,jk) = gdept_0(jk) 243 gdepw(:,:,jk) = gdepw_0(jk) 244 ENDDO 245 242 246 DO jj = 1, jpj 243 247 DO ji = 1, jpi … … 252 256 END DO 253 257 END DO 258 254 259 ENDIF 255 260 256 261 ENDIF 257 ! Vertical coordinates and scales factors258 CALL iom_get( inum4, jpdom_unknown, 'gdept_0', gdept_0 ) ! depth259 CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', gdepw_0 )260 CALL iom_get( inum4, jpdom_unknown, 'e3t_0' , e3t_0 )261 CALL iom_get( inum4, jpdom_unknown, 'e3w_0' , e3w_0 )262 262 # endif 263 263 IF( ln_zco ) THEN -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OFF_SRC/DOM/phycst.F90
r1746 r2007 37 37 rtt = 273.16_wp , & !: triple point of temperature (Kelvin) 38 38 rt0 = 273.15_wp , & !: freezing point of water (Kelvin) 39 rau0 = 1020._wp , & !: volumic mass of reference (kg/m3) 40 rauw = 1000._wp , & !: density of pure water (kg/m3) 39 rau0 = 1035._wp , & !: volumic mass of reference (kg/m3) 41 40 rcp = 4.e+3_wp, & !: ocean specific heat 42 41 ro0cpr !: = 1. / ( rau0 * rcp ) … … 127 126 ro0cpr = 1. / ( rau0 * rcp ) 128 127 IF(lwp) WRITE(numout,*) 129 IF(lwp) WRITE(numout,*) ' volumic mass of pure water rauw = ', rauw, ' kg/m^3'130 128 IF(lwp) WRITE(numout,*) ' volumic mass of reference rau0 = ', rau0, ' kg/m^3' 131 129 IF(lwp) WRITE(numout,*) ' ocean specific heat rcp = ', rcp -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OFF_SRC/lib_mpp.F90
r1324 r2007 105 105 !! ========================= !! 106 106 !$AGRIF_DO_NOT_TREAT 107 # include <mpif.h> 107 INCLUDE mpif.h 108 108 !$AGRIF_END_DO_NOT_TREAT 109 109 -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OFF_SRC/trc_oce.F90
r1445 r2007 39 39 !!---------------------------------------------------------------------- 40 40 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 41 !! $Id: trc_oce.F90 1 423 2009-05-06 16:22:01Z ctlod $41 !! $Id: trc_oce.F90 1834 2010-04-14 11:54:19Z cetlod $ 42 42 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 43 43 !!---------------------------------------------------------------------- … … 126 126 zrgb(1,51) = 3.162 ; zrgb(2,51) = 0.22703 ; zrgb(3,51) = 0.16599 ; zrgb(4,51) = 0.46601 127 127 zrgb(1,52) = 3.548 ; zrgb(2,52) = 0.24433 ; zrgb(3,52) = 0.17334 ; zrgb(4,52) = 0.47313 128 zrgb(1,53) = 3.981 ; zrgb(2,53) = 0.26301 ; zrgb(3,53) = 0.18126 ; zrgb(4,5 4) = 0.48080129 zrgb(1,54) = 4.467 ; zrgb(2,54) = 0.28320 ; zrgb(3,54) = 0.18981 ; zrgb(4,5 5) = 0.48909130 zrgb(1,55) = 5.012 ; zrgb(2,55) = 0.30502 ; zrgb(3,55) = 0.19903 ; zrgb(4,5 6) = 0.49803131 zrgb(1,56) = 5.623 ; zrgb(2,56) = 0.32858 ; zrgb(3,56) = 0.20898 ; zrgb(4,5 7) = 0.50768132 zrgb(1,57) = 6.310 ; zrgb(2,57) = 0.35404 ; zrgb(3,57) = 0.21971 ; zrgb(4,5 8) = 0.51810133 zrgb(1,58) = 7.079 ; zrgb(2,58) = 0.38154 ; zrgb(3,58) = 0.23129 ; zrgb(4,5 9) = 0.52934134 zrgb(1,59) = 7.943 ; zrgb(2,59) = 0.41125 ; zrgb(3,59) = 0.24378 ; zrgb(4,5 0) = 0.54147128 zrgb(1,53) = 3.981 ; zrgb(2,53) = 0.26301 ; zrgb(3,53) = 0.18126 ; zrgb(4,53) = 0.48080 129 zrgb(1,54) = 4.467 ; zrgb(2,54) = 0.28320 ; zrgb(3,54) = 0.18981 ; zrgb(4,54) = 0.48909 130 zrgb(1,55) = 5.012 ; zrgb(2,55) = 0.30502 ; zrgb(3,55) = 0.19903 ; zrgb(4,55) = 0.49803 131 zrgb(1,56) = 5.623 ; zrgb(2,56) = 0.32858 ; zrgb(3,56) = 0.20898 ; zrgb(4,56) = 0.50768 132 zrgb(1,57) = 6.310 ; zrgb(2,57) = 0.35404 ; zrgb(3,57) = 0.21971 ; zrgb(4,57) = 0.51810 133 zrgb(1,58) = 7.079 ; zrgb(2,58) = 0.38154 ; zrgb(3,58) = 0.23129 ; zrgb(4,58) = 0.52934 134 zrgb(1,59) = 7.943 ; zrgb(2,59) = 0.41125 ; zrgb(3,59) = 0.24378 ; zrgb(4,59) = 0.54147 135 135 zrgb(1,60) = 8.912 ; zrgb(2,60) = 0.44336 ; zrgb(3,60) = 0.25725 ; zrgb(4,60) = 0.55457 136 136 zrgb(1,61) = 10.000 ; zrgb(2,61) = 0.47804 ; zrgb(3,61) = 0.27178 ; zrgb(4,61) = 0.56870 -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r1756 r2007 175 175 thick0(:,:) = 0.e0 176 176 DO jk = 1, jpkm1 177 vol0 = vol0 + SUM( area (:,:) * tmask(:,:,jk) ) * e3t_0(jk) 178 thick0(:,:) = thick0(:,:) + tmask_i(:,:) * tmask(:,:,jk) * e3t_0(jk) 179 END DO 177 vol0 = vol0 + SUM( area (:,:) * tmask(:,:,jk) * fse3t_0(:,:,jk) ) 178 thick0(:,:) = thick0(:,:) + tmask_i(:,:) * tmask(:,:,jk) * fse3t_0(:,:,jk) 179 END DO 180 IF( lk_mpp ) CALL mpp_sum( vol0 ) 180 181 181 182 CALL iom_open ( 'data_1m_salinity_nomask', inum ) -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90
r1715 r2007 10 10 USE dom_oce ! ocean space and time domain 11 11 USE in_out_manager ! I/O manager 12 USE daymod ! calendar 12 13 13 14 IMPLICIT NONE … … 21 22 !!---------------------------------------------------------------------- 22 23 !! OPA 9.0 , LOCEAN-IPSL (2005) 23 !! $ Id$24 !! $Header$ 24 25 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 25 26 !!---------------------------------------------------------------------- … … 56 57 INTEGER :: jk, jn ! dummy loop indices 57 58 INTEGER :: irecl4, & ! record length in bytes 58 & inum, & ! logical unit 59 & irec ! current record to be written 59 & inum, & ! logical unit (set to 14) 60 & irec, & ! current record to be written 61 & irecend ! record number where nclit... are stored 60 62 REAL(sp) :: zdx,zdy,zspval,zwest,ztimm 61 63 REAL(sp) :: zsouth … … 69 71 !! * Initialisations 70 72 71 irecl4 = MAX(jpi*jpj*sp , 84+ 18*sp + (jpk+8)*jpnij*sp)73 irecl4 = MAX(jpi*jpj*sp , 84+(18+1+jpk)*sp ) 72 74 73 75 zspval=0.0_sp ! special values on land … … 101 103 102 104 IF ( ln_dimgnnn ) THEN 105 irecl4 = MAX(jpi*jpj*sp , 84+(18+jpk)*sp + 8*jpnij*sp ) 103 106 WRITE(clname,'(a,a,i3.3)') TRIM(cd_name),'.',narea 104 CALL ctl_opn( inum, clname, 'REPLACE', 'UNFORMATTED', 'DIRECT', irecl4, numout, lwp)107 CALL ctl_opn(inum, clname,'UNKNOWN','UNFORMATTED','DIRECT',irecl4,numout,lwp) 105 108 WRITE(inum,REC=1 ) clver, cd_text, irecl4, & 106 109 & jpi,jpj, klev, 1 , 1 , & … … 127 130 ENDIF 128 131 ELSE 132 clver='@!03' ! dimg string identifier 133 ! note that version @!02 is optimized with respect to record length. 134 ! The vertical dep variable is reduced to klev instead of klev*jpnij : 135 ! this is OK for jpnij < 181 (jpk=46) 136 ! for more processors, irecl4 get huge and that's why we switch to '@!03': 137 ! In this case we just add an extra integer to the standard dimg structure, 138 ! which is a record number where the arrays nlci etc... starts (1 per record) 139 129 140 !! Standard dimgproc (1 file per variable, all procs. write to this file ) 130 141 !! * Open file 131 CALL ctl_opn( inum, cd_name, 'REPLACE', 'UNFORMATTED', 'DIRECT', irecl4, numout, lwp)142 CALL ctl_opn(inum, cd_name,'UNKNOWN','UNFORMATTED','DIRECT',irecl4,numout,lwp) 132 143 133 144 !! * Write header on record #1 145 irecend=1 + klev*jpnij 134 146 IF(lwp) WRITE(inum,REC=1 ) clver, cd_text, irecl4, & 135 & jpi,jpj, klev *jpnij, 1 , 1 , &147 & jpi,jpj, klev, 1 , 1 , & 136 148 & zwest, zsouth, zdx, zdy, zspval, & 137 & (z4dep(1:klev),jn=1,jpnij), &149 & z4dep(1:klev), & 138 150 & ztimm, & 139 & narea, jpnij,jpiglo,jpjglo,jpizoom, jpjzoom, & ! extension to dimg for mpp output 140 & nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt ! 151 & narea, jpnij,jpiglo,jpjglo,jpizoom, jpjzoom, irecend 152 IF (lwp ) THEN 153 WRITE(inum,REC=irecend + 1 ) nlcit 154 WRITE(inum,REC=irecend + 2 ) nlcjt 155 WRITE(inum,REC=irecend + 3 ) nldit 156 WRITE(inum,REC=irecend + 4 ) nldjt 157 WRITE(inum,REC=irecend + 5 ) nleit 158 WRITE(inum,REC=irecend + 6 ) nlejt 159 WRITE(inum,REC=irecend + 7 ) nimppt 160 WRITE(inum,REC=irecend + 8 ) njmppt 161 ENDIF 162 ! & ! extension to dimg for mpp output 163 ! & nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt ! 141 164 142 165 !! * Write klev levels -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90
r1731 r2007 129 129 130 130 cdfnam = TRIM(cexper)//TRIM(clave)//"_"//TRIM(cldate1)//"_"//TRIM(cldate2)//"_"//TRIM(cdsuff) 131 #if defined key_agrif 132 if ( .NOT. Agrif_Root() ) cdfnam = TRIM(Agrif_CFixed())//'_'//TRIM(cdfnam) 133 #endif 131 IF( .NOT. Agrif_Root() ) cdfnam = TRIM(Agrif_CFixed())//'_'//TRIM(cdfnam) 134 132 135 133 END SUBROUTINE dia_nam -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r1775 r2007 362 362 #endif 363 363 364 ! Transports 365 ! T times V on T points (include bolus velocities) 366 #if defined key_diaeiv 367 DO jj = 2, jpj 368 DO ji = 1, jpi 369 vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + u_eiv(ji,jj,:) + u_eiv(ji,jj-1,:) )*0.5 370 vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + v_eiv(ji,jj,:) + v_eiv(ji,jj-1,:) )*0.5 371 END DO 372 END DO 373 #else 374 DO jj = 2, jpj 375 DO ji = 1, jpi 376 vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 377 vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 378 END DO 379 END DO 380 #endif 381 CALL lbc_lnk( vs, 'V', -1. ) ; CALL lbc_lnk( vt, 'V', -1. ) 382 383 ht_glo(:) = SUM( ptr_vjk( vt(:,:,:)), 2 ) 384 st_glo(:) = SUM( ptr_vjk( vs(:,:,:)), 2 ) 385 386 IF ( ln_subbas ) THEN 387 ht_atl(:) = SUM( ptr_vjk( vt (:,:,:), abasin(:,:)*sbasin(:,:)), 2 ) 388 ht_pac(:) = SUM( ptr_vjk( vt (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 ) 389 ht_ind(:) = SUM( ptr_vjk( vt (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 ) 390 ht_ipc(:) = SUM( ptr_vjk( vt (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 ) 391 st_atl(:) = SUM( ptr_vjk( vs (:,:,:), abasin(:,:)*sbasin(:,:)), 2 ) 392 st_pac(:) = SUM( ptr_vjk( vs (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 ) 393 st_ind(:) = SUM( ptr_vjk( vs (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 ) 394 st_ipc(:) = SUM( ptr_vjk( vs (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 ) 395 ENDIF 396 397 ! poleward tracer transports: 398 ! overturning components: 399 IF ( ln_ptrcomp ) THEN 400 pht_ove_glo(:) = SUM( v_msf_glo(:,:) * tn_jk_glo(:,:), 2 ) ! SUM over jk 401 pst_ove_glo(:) = SUM( v_msf_glo(:,:) * sn_jk_glo(:,:), 2 ) 402 IF ( ln_subbas ) THEN 403 pht_ove_atl(:) = SUM( v_msf_atl(:,:) * tn_jk_atl(:,:), 2 ) ! SUM over jk 404 pst_ove_atl(:) = SUM( v_msf_atl(:,:) * sn_jk_atl(:,:), 2 ) 405 pht_ove_pac(:) = SUM( v_msf_pac(:,:) * tn_jk_pac(:,:), 2 ) ! SUM over jk 406 pst_ove_pac(:) = SUM( v_msf_pac(:,:) * sn_jk_pac(:,:), 2 ) 407 pht_ove_ind(:) = SUM( v_msf_ind(:,:) * tn_jk_ind(:,:), 2 ) ! SUM over jk 408 pst_ove_ind(:) = SUM( v_msf_ind(:,:) * sn_jk_ind(:,:), 2 ) 409 pht_ove_ipc(:) = SUM( v_msf_ipc(:,:) * tn_jk_ipc(:,:), 2 ) ! SUM over jk 410 pst_ove_ipc(:) = SUM( v_msf_ipc(:,:) * sn_jk_ipc(:,:), 2 ) 411 END IF 412 END IF 413 414 ! Bolus component 415 #if defined key_diaeiv 416 pht_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_glo(:,:), 2 ) ! SUM over jk 417 pst_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_glo(:,:), 2 ) ! SUM over jk 418 IF ( ln_subbas ) THEN 419 pht_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_atl(:,:), 2 ) ! SUM over jk 420 pst_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_atl(:,:), 2 ) ! SUM over jk 421 pht_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * tn_jk_pac(:,:), 2 ) ! SUM over jk 422 pst_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * sn_jk_pac(:,:), 2 ) ! SUM over jk 423 pht_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * tn_jk_ind(:,:), 2 ) ! SUM over jk 424 pst_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * sn_jk_ind(:,:), 2 ) ! SUM over jk 425 pht_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * tn_jk_ipc(:,:), 2 ) ! SUM over jk 426 pst_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * sn_jk_ipc(:,:), 2 ) ! SUM over jk 427 ENDIF 428 #endif 429 430 ! conversion in PW and G g 431 zpwatt = zpwatt * rau0 * rcp 432 pht_adv(:) = pht_adv(:) * zpwatt 433 pht_ldf(:) = pht_ldf(:) * zpwatt 434 pst_adv(:) = pst_adv(:) * zggram 435 pst_ldf(:) = pst_ldf(:) * zggram 436 IF ( ln_ptrcomp ) THEN 437 pht_ove_glo(:) = pht_ove_glo(:) * zpwatt 438 pst_ove_glo(:) = pst_ove_glo(:) * zggram 439 END IF 440 #if defined key_diaeiv 441 pht_eiv_glo(:) = pht_eiv_glo(:) * zpwatt 442 pst_eiv_glo(:) = pst_eiv_glo(:) * zggram 443 #endif 444 IF( ln_subbas ) THEN 445 ht_atl(:) = ht_atl(:) * zpwatt 446 ht_pac(:) = ht_pac(:) * zpwatt 447 ht_ind(:) = ht_ind(:) * zpwatt 448 ht_ipc(:) = ht_ipc(:) * zpwatt 449 st_atl(:) = st_atl(:) * zggram 450 st_pac(:) = st_pac(:) * zggram 451 st_ind(:) = st_ind(:) * zggram 452 st_ipc(:) = st_ipc(:) * zggram 453 ENDIF 454 364 455 ! "Meridional" Stream-Function 365 456 DO jk = 2,jpk … … 394 485 v_msf_ind(:,:) = v_msf_ind(:,:) * zsverdrup 395 486 v_msf_ipc(:,:) = v_msf_ipc(:,:) * zsverdrup 396 ENDIF397 398 ! Transports399 ! T times V on T points (include bolus velocities)400 #if defined key_diaeiv401 DO jj = 2, jpj402 DO ji = 1, jpi403 vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + u_eiv(ji,jj,:) + u_eiv(ji,jj-1,:) )*0.5404 vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + v_eiv(ji,jj,:) + v_eiv(ji,jj-1,:) )*0.5405 END DO406 END DO407 #else408 DO jj = 2, jpj409 DO ji = 1, jpi410 vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5411 vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5412 END DO413 END DO414 #endif415 CALL lbc_lnk( vs, 'V', -1. ) ; CALL lbc_lnk( vt, 'V', -1. )416 417 ht_glo(:) = SUM( ptr_vjk( vt(:,:,:)), 2 )418 st_glo(:) = SUM( ptr_vjk( vs(:,:,:)), 2 )419 420 IF ( ln_subbas ) THEN421 ht_atl(:) = SUM( ptr_vjk( vt (:,:,:), abasin(:,:)*sbasin(:,:)), 2 )422 ht_pac(:) = SUM( ptr_vjk( vt (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 )423 ht_ind(:) = SUM( ptr_vjk( vt (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 )424 ht_ipc(:) = SUM( ptr_vjk( vt (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 )425 st_atl(:) = SUM( ptr_vjk( vs (:,:,:), abasin(:,:)*sbasin(:,:)), 2 )426 st_pac(:) = SUM( ptr_vjk( vs (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 )427 st_ind(:) = SUM( ptr_vjk( vs (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 )428 st_ipc(:) = SUM( ptr_vjk( vs (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 )429 ENDIF430 431 ! poleward tracer transports:432 ! overturning components:433 IF ( ln_ptrcomp ) THEN434 pht_ove_glo(:) = SUM( v_msf_glo(:,:) * tn_jk_glo(:,:), 2 ) ! SUM over jk435 pst_ove_glo(:) = SUM( v_msf_glo(:,:) * sn_jk_glo(:,:), 2 )436 IF ( ln_subbas ) THEN437 pht_ove_atl(:) = SUM( v_msf_atl(:,:) * tn_jk_atl(:,:), 2 ) ! SUM over jk438 pst_ove_atl(:) = SUM( v_msf_atl(:,:) * sn_jk_atl(:,:), 2 )439 pht_ove_pac(:) = SUM( v_msf_pac(:,:) * tn_jk_pac(:,:), 2 ) ! SUM over jk440 pst_ove_pac(:) = SUM( v_msf_pac(:,:) * sn_jk_pac(:,:), 2 )441 pht_ove_ind(:) = SUM( v_msf_ind(:,:) * tn_jk_ind(:,:), 2 ) ! SUM over jk442 pst_ove_ind(:) = SUM( v_msf_ind(:,:) * sn_jk_ind(:,:), 2 )443 pht_ove_ipc(:) = SUM( v_msf_ipc(:,:) * tn_jk_ipc(:,:), 2 ) ! SUM over jk444 pst_ove_ipc(:) = SUM( v_msf_ipc(:,:) * sn_jk_ipc(:,:), 2 )445 END IF446 END IF447 448 ! Bolus component449 #if defined key_diaeiv450 pht_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_glo(:,:), 2 ) ! SUM over jk451 pst_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_glo(:,:), 2 ) ! SUM over jk452 IF ( ln_subbas ) THEN453 pht_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_atl(:,:), 2 ) ! SUM over jk454 pst_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_atl(:,:), 2 ) ! SUM over jk455 pht_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * tn_jk_pac(:,:), 2 ) ! SUM over jk456 pst_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * sn_jk_pac(:,:), 2 ) ! SUM over jk457 pht_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * tn_jk_ind(:,:), 2 ) ! SUM over jk458 pst_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * sn_jk_ind(:,:), 2 ) ! SUM over jk459 pht_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * tn_jk_ipc(:,:), 2 ) ! SUM over jk460 pst_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * sn_jk_ipc(:,:), 2 ) ! SUM over jk461 ENDIF462 #endif463 464 ! conversion in PW and G g465 zpwatt = zpwatt * rau0 * rcp466 pht_adv(:) = pht_adv(:) * zpwatt467 pht_ldf(:) = pht_ldf(:) * zpwatt468 pst_adv(:) = pst_adv(:) * zggram469 pst_ldf(:) = pst_ldf(:) * zggram470 IF ( ln_ptrcomp ) THEN471 pht_ove_glo(:) = pht_ove_glo(:) * zpwatt472 pst_ove_glo(:) = pst_ove_glo(:) * zggram473 END IF474 #if defined key_diaeiv475 pht_eiv_glo(:) = pht_eiv_glo(:) * zpwatt476 pst_eiv_glo(:) = pst_eiv_glo(:) * zggram477 #endif478 IF( ln_subbas ) THEN479 ht_atl(:) = ht_atl(:) * zpwatt480 ht_pac(:) = ht_pac(:) * zpwatt481 ht_ind(:) = ht_ind(:) * zpwatt482 ht_ipc(:) = ht_ipc(:) * zpwatt483 st_atl(:) = st_atl(:) * zggram484 st_pac(:) = st_pac(:) * zggram485 st_ind(:) = st_ind(:) * zggram486 st_ipc(:) = st_ipc(:) * zggram487 487 ENDIF 488 488 ENDIF -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r1756 r2007 629 629 ! Define name, frequency of output and means 630 630 clname = cdfile_name 631 #if defined key_agrif 632 if ( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 633 #endif 631 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 634 632 zdt = rdt 635 633 zsto = rdt -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r1730 r2007 219 219 #else 220 220 LOGICAL, PUBLIC, PARAMETER :: lk_agrif = .FALSE. !: agrif flag 221 222 CONTAINS 223 LOGICAL FUNCTION Agrif_Root() 224 Agrif_Root = .TRUE. 225 END FUNCTION Agrif_Root 226 227 CHARACTER(len=3) FUNCTION Agrif_CFixed() 228 Agrif_CFixed = '0' 229 END FUNCTION Agrif_CFixed 221 230 #endif 222 231 -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r1732 r2007 166 166 ENDIF 167 167 168 #if defined key_agrif169 168 IF( Agrif_Root() ) THEN 170 #endif 171 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 172 CASE ( 1 ) 173 CALL ioconf_calendar('gregorian') 174 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "gregorian", i.e. leap year' 175 CASE ( 0 ) 176 CALL ioconf_calendar('noleap') 177 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "noleap", i.e. no leap year' 178 CASE ( 30 ) 179 CALL ioconf_calendar('360d') 180 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "360d", i.e. 360 days in a year' 181 END SELECT 182 #if defined key_agrif 183 ENDIF 184 #endif 169 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 170 CASE ( 1 ) 171 CALL ioconf_calendar('gregorian') 172 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "gregorian", i.e. leap year' 173 CASE ( 0 ) 174 CALL ioconf_calendar('noleap') 175 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "noleap", i.e. no leap year' 176 CASE ( 30 ) 177 CALL ioconf_calendar('360d') 178 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "360d", i.e. 360 days in a year' 179 END SELECT 180 ENDIF 185 181 186 182 REWIND( numnam ) ! Namelist namdom : space & time domain (bathymetry, mesh, timestep) -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r1707 r2007 270 270 271 271 #if defined key_agrif && defined key_eel_r6 272 IF (.Not.Agrif_Root()) THEN272 IF( .NOT. Agrif_Root() ) THEN 273 273 glam0 = Agrif_Parent(glam0) + (Agrif_ix())*Agrif_Parent(ppe1_m) * 1.e-3 274 274 gphi0 = Agrif_Parent(gphi0) + (Agrif_iy())*Agrif_Parent(ppe2_m) * 1.e-3 … … 465 465 466 466 #if defined key_agrif && defined key_eel_r6 467 IF (.Not.Agrif_Root()) THEN467 IF( .NOT. Agrif_Root() ) THEN 468 468 zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 469 469 ENDIF -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r1694 r2007 62 62 IF( lk_zco ) CALL ctl_stop( 'dom_vvl : key_zco is incompatible with variable volume option key_vvl') 63 63 64 fsdept(:,:,:) = gdept (:,:,:) 65 fsdepw(:,:,:) = gdepw (:,:,:) 66 fsde3w(:,:,:) = gdep3w(:,:,:) 67 fse3t (:,:,:) = e3t (:,:,:) 68 fse3u (:,:,:) = e3u (:,:,:) 69 fse3v (:,:,:) = e3v (:,:,:) 70 fse3f (:,:,:) = e3f (:,:,:) 71 fse3w (:,:,:) = e3w (:,:,:) 72 fse3uw(:,:,:) = e3uw (:,:,:) 73 fse3vw(:,:,:) = e3vw (:,:,:) 64 IF( ln_zco) THEN 65 DO jk = 1, jpk 66 gdept(:,:,jk) = gdept_0(jk) 67 gdepw(:,:,jk) = gdepw_0(jk) 68 gdep3w(:,:,jk) = gdepw_0(jk) 69 e3t (:,:,jk) = e3t_0(jk) 70 e3u (:,:,jk) = e3t_0(jk) 71 e3v (:,:,jk) = e3t_0(jk) 72 e3f (:,:,jk) = e3t_0(jk) 73 e3w (:,:,jk) = e3w_0(jk) 74 e3uw(:,:,jk) = e3w_0(jk) 75 e3vw(:,:,jk) = e3w_0(jk) 76 END DO 77 ELSE 78 fsdept(:,:,:) = gdept (:,:,:) 79 fsdepw(:,:,:) = gdepw (:,:,:) 80 fsde3w(:,:,:) = gdep3w(:,:,:) 81 fse3t (:,:,:) = e3t (:,:,:) 82 fse3u (:,:,:) = e3u (:,:,:) 83 fse3v (:,:,:) = e3v (:,:,:) 84 fse3f (:,:,:) = e3f (:,:,:) 85 fse3w (:,:,:) = e3w (:,:,:) 86 fse3uw(:,:,:) = e3uw (:,:,:) 87 fse3vw(:,:,:) = e3vw (:,:,:) 88 ENDIF 74 89 75 90 ! !== mu computation ==! … … 139 154 CALL lbc_lnk( sshf_b, 'F', 1. ) ; CALL lbc_lnk( sshf_n, 'F', 1. ) 140 155 ! 156 DO jk = 1, jpkm1 157 fsdept(:,:,jk) = fsdept_n(:,:,jk) ! now local depths stored in fsdep. arrays 158 fsdepw(:,:,jk) = fsdepw_n(:,:,jk) 159 fsde3w(:,:,jk) = fsde3w_n(:,:,jk) 160 ! 161 fse3t (:,:,jk) = fse3t_n (:,:,jk) ! vertical scale factors stored in fse3. arrays 162 fse3u (:,:,jk) = fse3u_n (:,:,jk) 163 fse3v (:,:,jk) = fse3v_n (:,:,jk) 164 fse3f (:,:,jk) = fse3f_n (:,:,jk) 165 fse3w (:,:,jk) = fse3w_n (:,:,jk) 166 fse3uw(:,:,jk) = fse3uw_n(:,:,jk) 167 fse3vw(:,:,jk) = fse3vw_n(:,:,jk) 168 END DO 169 170 171 141 172 END SUBROUTINE dom_vvl 142 173 -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
r1590 r2007 45 45 !! domhgr, domzgr, and dommsk. Note: the file contain depends on 46 46 !! the vertical coord. used (z-coord, partial steps, s-coord) 47 !! nmsh= 1 : 'mesh_mask.nc' file47 !! MOD(nmsh, 3) = 1 : 'mesh_mask.nc' file 48 48 !! = 2 : 'mesh.nc' and mask.nc' files 49 !! = 3: 'mesh_hgr.nc', 'mesh_zgr.nc' and49 !! = 0 : 'mesh_hgr.nc', 'mesh_zgr.nc' and 50 50 !! 'mask.nc' files 51 51 !! For huge size domain, use option 2 or 3 depending on your 52 52 !! vertical coordinate. 53 !! 54 !! if nmsh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw] 55 !! if 3 < nmsh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays 56 !! corresponding to the depth of the bottom points hdep[tw] 57 !! if 6 < nmsh <= 9: write 2D arrays corresponding to the depth and the 58 !! thickness of the bottom points hdep[tw] and e3[tw]_ps 53 59 !! 54 60 !! ** output file : … … 241 247 ! ! close the files 242 248 ! ! ============================ 243 SELECT CASE ( nmsh)249 SELECT CASE ( MOD(nmsh, 3) ) 244 250 CASE ( 1 ) 245 251 CALL iom_close( inum0 ) … … 247 253 CALL iom_close( inum1 ) 248 254 CALL iom_close( inum2 ) 249 CASE ( 3)255 CASE ( 0 ) 250 256 CALL iom_close( inum2 ) 251 257 CALL iom_close( inum3 ) -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r1739 r2007 4 4 !! Definition of of both ocean and ice parameters used in the code 5 5 !!===================================================================== 6 !! History : !90-10 (C. Levy - G. Madec) Original code7 !! ! 91-11 (G. Madec)8 !! ! 91-12 (M. Imbard)9 !! 8.5 ! 02-08 (G. Madec, C. Ethe) F90, add ice constants10 !! 9.0 ! 06-08 (G. Madec)style6 !! History : OPA ! 1990-10 (C. Levy - G. Madec) Original code 7 !! 8.1 ! 1991-11 (G. Madec, M. Imbard) cosmetic changes 8 !! NEMO 1.0 ! 2002-08 (G. Madec, C. Ethe) F90, add ice constants 9 !! - ! 2006-08 (G. Madec) style 10 !! 3.2 ! 2006-08 (S. Masson, G. Madec) suppress useless variables + style 11 11 !!---------------------------------------------------------------------- 12 12 … … 24 24 REAL(wp), PUBLIC :: rpi = 3.141592653589793_wp !: pi 25 25 REAL(wp), PUBLIC :: rad = 3.141592653589793_wp / 180._wp !: conversion from degre into radian 26 REAL(wp), PUBLIC :: rsmall = 0.5 * EPSILON( 1. )!: smallest real computer value26 REAL(wp), PUBLIC :: rsmall = 0.5 * EPSILON( 1.e0 ) !: smallest real computer value 27 27 28 REAL(wp), PUBLIC :: & !: 29 rday = 24.*60.*60. , & !: day (s) 30 rsiyea , & !: sideral year (s) 31 rsiday , & !: sideral day (s) 32 raamo = 12._wp , & !: number of months in one year 33 rjjhh = 24._wp , & !: number of hours in one day 34 rhhmm = 60._wp , & !: number of minutes in one hour 35 rmmss = 60._wp , & !: number of seconds in one minute 36 !!! omega = 7.292115083046061e-5_wp , & !: change the last digit! 37 omega , & !: earth rotation parameter 38 ra = 6371229._wp , & !: earth radius (meter) 39 grav = 9.80665_wp !: gravity (m/s2) 28 REAL(wp), PUBLIC :: rday = 24.*60.*60. !: day (s) 29 REAL(wp), PUBLIC :: rsiyea !: sideral year (s) 30 REAL(wp), PUBLIC :: rsiday !: sideral day (s) 31 REAL(wp), PUBLIC :: raamo = 12._wp !: number of months in one year 32 REAL(wp), PUBLIC :: rjjhh = 24._wp !: number of hours in one day 33 REAL(wp), PUBLIC :: rhhmm = 60._wp !: number of minutes in one hour 34 REAL(wp), PUBLIC :: rmmss = 60._wp !: number of seconds in one minute 35 !! REAL(wp), PUBLIC :: omega = 7.292115083046061e-5_wp , & !: change the last digit! 36 REAL(wp), PUBLIC :: omega !: earth rotation parameter 37 REAL(wp), PUBLIC :: ra = 6371229._wp !: earth radius (meter) 38 REAL(wp), PUBLIC :: grav = 9.80665_wp !: gravity (m/s2) 40 39 41 REAL(wp), PUBLIC :: & !: 42 rtt = 273.16_wp , & !: triple point of temperature (Kelvin) 43 rt0 = 273.15_wp , & !: freezing point of water (Kelvin) 40 REAL(wp), PUBLIC :: rtt = 273.16_wp !: triple point of temperature (Kelvin) 41 REAL(wp), PUBLIC :: rt0 = 273.15_wp !: freezing point of water (Kelvin) 44 42 #if defined key_lim3 45 rt0_snow = 273.16_wp , &!: melting point of snow (Kelvin)46 rt0_ice = 273.16_wp , &!: melting point of ice (Kelvin)43 REAL(wp), PUBLIC :: rt0_snow = 273.16_wp !: melting point of snow (Kelvin) 44 REAL(wp), PUBLIC :: rt0_ice = 273.16_wp !: melting point of ice (Kelvin) 47 45 #else 48 rt0_snow = 273.15_wp , &!: melting point of snow (Kelvin)49 rt0_ice = 273.05_wp , &!: melting point of ice (Kelvin)46 REAL(wp), PUBLIC :: rt0_snow = 273.15_wp !: melting point of snow (Kelvin) 47 REAL(wp), PUBLIC :: rt0_ice = 273.05_wp !: melting point of ice (Kelvin) 50 48 #endif 51 rau0 = 1035._wp , & !: volumic mass of reference (kg/m3)52 rauw = 1000._wp , & !: volumic mass of pure water (kg/m3)53 rcp = 4.e+3_wp, & !: ocean specific heat54 ro0cpr !: = 1. / ( rau0 * rcp )55 49 56 REAL(wp), PUBLIC :: & !: 50 REAL(wp), PUBLIC :: rau0 = 1020._wp !: reference volumic mass (density) (kg/m3) 51 REAL(wp), PUBLIC :: rau0r !: reference specific volume (m3/kg) 52 REAL(wp), PUBLIC :: rcp = 4.e+3_wp !: ocean specific heat 53 REAL(wp), PUBLIC :: ro0cpr !: = 1. / ( rau0 * rcp ) 54 57 55 #if defined key_lim3 58 rcdsn = 0.31_wp , & !: thermal conductivity of snow 59 rcdic = 2.034396_wp , & !: thermal conductivity of fresh ice 60 cpic = 2067.0 , & 61 ! add the following lines 62 lsub = 2.834e+6 , & !: pure ice latent heat of sublimation (J.kg-1) 63 lfus = 0.334e+6 , & !: latent heat of fusion of fresh ice (J.kg-1) 64 rhoic = 917._wp , & !: volumic mass of sea ice (kg/m3) 65 tmut = 0.054 , & !: decrease of seawater meltpoint with salinity 56 REAL(wp), PUBLIC :: rcdsn = 0.31_wp !: thermal conductivity of snow 57 REAL(wp), PUBLIC :: rcdic = 2.034396_wp !: thermal conductivity of fresh ice 58 REAL(wp), PUBLIC :: cpic = 2067.0 !: specific heat of sea ice 59 REAL(wp), PUBLIC :: lsub = 2.834e+6 !: pure ice latent heat of sublimation (J.kg-1) 60 REAL(wp), PUBLIC :: lfus = 0.334e+6 !: latent heat of fusion of fresh ice (J.kg-1) 61 REAL(wp), PUBLIC :: rhoic = 917._wp !: volumic mass of sea ice (kg/m3) 62 REAL(wp), PUBLIC :: tmut = 0.054 !: decrease of seawater meltpoint with salinity 66 63 #else 67 rcdsn = 0.22_wp , &!: conductivity of the snow68 rcdic = 2.034396_wp , &!: conductivity of the ice69 rcpsn = 6.9069e+5_wp, &!: density times specific heat for snow70 rcpic = 1.8837e+6_wp, &!: volumetric latent heat fusion of sea ice71 xlsn = 110.121e+6_wp , &!: volumetric latent heat fusion of snow72 xlic = 300.33e+6_wp , &!: volumetric latent heat fusion of ice73 xsn = 2.8e+6 , &!: latent heat of sublimation of snow74 rhoic = 900._wp , &!: volumic mass of sea ice (kg/m3)64 REAL(wp), PUBLIC :: rcdsn = 0.22_wp !: conductivity of the snow 65 REAL(wp), PUBLIC :: rcdic = 2.034396_wp !: conductivity of the ice 66 REAL(wp), PUBLIC :: rcpsn = 6.9069e+5_wp !: density times specific heat for snow 67 REAL(wp), PUBLIC :: rcpic = 1.8837e+6_wp !: volumetric latent heat fusion of sea ice 68 REAL(wp), PUBLIC :: xlsn = 110.121e+6_wp !: volumetric latent heat fusion of snow 69 REAL(wp), PUBLIC :: xlic = 300.33e+6_wp !: volumetric latent heat fusion of ice 70 REAL(wp), PUBLIC :: xsn = 2.8e+6 !: latent heat of sublimation of snow 71 REAL(wp), PUBLIC :: rhoic = 900._wp !: volumic mass of sea ice (kg/m3) 75 72 #endif 76 rhosn = 330._wp , &!: volumic mass of snow (kg/m3)77 emic = 0.97_wp , &!: emissivity of snow or ice78 sice = 6.0_wp , & !:salinity of ice (psu)79 soce = 34.7_wp , & !:salinity of sea (psu)80 cevap = 2.5e+6_wp , &!: latent heat of evaporation (water)81 srgamma = 0.9_wp , &!: correction factor for solar radiation (Oberhuber, 1974)82 vkarmn = 0.4_wp , &!: von Karman constant83 stefan = 5.67e-8_wp!: Stefan-Boltzmann constant84 85 !! OPA 9.0 , LOCEAN-IPSL (2005)86 87 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt88 73 REAL(wp), PUBLIC :: rhosn = 330._wp !: volumic mass of snow (kg/m3) 74 REAL(wp), PUBLIC :: emic = 0.97_wp !: emissivity of snow or ice 75 REAL(wp), PUBLIC :: sice = 6.0_wp !: reference salinity of ice (psu) 76 REAL(wp), PUBLIC :: soce = 34.7_wp !: reference salinity of sea (psu) 77 REAL(wp), PUBLIC :: cevap = 2.5e+6_wp !: latent heat of evaporation (water) 78 REAL(wp), PUBLIC :: srgamma = 0.9_wp !: correction factor for solar radiation (Oberhuber, 1974) 79 REAL(wp), PUBLIC :: vkarmn = 0.4_wp !: von Karman constant 80 REAL(wp), PUBLIC :: stefan = 5.67e-8_wp !: Stefan-Boltzmann constant 81 !!---------------------------------------------------------------------- 82 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 83 !! $Id$ 84 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 85 !!---------------------------------------------------------------------- 89 86 90 87 CONTAINS … … 99 96 !!---------------------------------------------------------------------- 100 97 101 IF(lwp) WRITE(numout,*) 102 IF(lwp) WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants' 103 IF(lwp) WRITE(numout,*) ' ~~~~~~~' 98 ! ! Define additional parameters 99 rsiyea = 365.25 * rday * 2. * rpi / 6.283076 100 rsiday = rday / ( 1. + rday / rsiyea ) 101 omega = 2. * rpi / rsiday 104 102 105 ! Ocean Parameters 106 ! ---------------- 107 IF(lwp) THEN 103 rau0r = 1. / rau0 104 ro0cpr = 1. / ( rau0 * rcp ) 105 106 107 IF(lwp) THEN ! control print 108 WRITE(numout,*) 109 WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants' 110 WRITE(numout,*) ' ~~~~~~~' 108 111 WRITE(numout,*) ' Domain info' 109 112 WRITE(numout,*) ' dimension of model' … … 118 121 WRITE(numout,*) ' jpnij : ', jpnij 119 122 WRITE(numout,*) ' lateral domain boundary condition type : jperio = ', jperio 120 ENDIF 121 122 ! Define constants 123 ! ---------------- 124 IF(lwp) WRITE(numout,*) 125 IF(lwp) WRITE(numout,*) ' Constants' 126 127 IF(lwp) WRITE(numout,*) 128 IF(lwp) WRITE(numout,*) ' mathematical constant rpi = ', rpi 129 130 rsiyea = 365.25 * rday * 2. * rpi / 6.283076 131 rsiday = rday / ( 1. + rday / rsiyea ) 132 omega = 2. * rpi / rsiday 133 IF(lwp) WRITE(numout,*) 134 IF(lwp) WRITE(numout,*) ' day rday = ', rday, ' s' 135 IF(lwp) WRITE(numout,*) ' sideral year rsiyea = ', rsiyea, ' s' 136 IF(lwp) WRITE(numout,*) ' sideral day rsiday = ', rsiday, ' s' 137 IF(lwp) WRITE(numout,*) ' omega omega = ', omega, ' s-1' 138 139 IF(lwp) WRITE(numout,*) 140 IF(lwp) WRITE(numout,*) ' nb of months per year raamo = ', raamo, ' months' 141 IF(lwp) WRITE(numout,*) ' nb of hours per day rjjhh = ', rjjhh, ' hours' 142 IF(lwp) WRITE(numout,*) ' nb of minutes per hour rhhmm = ', rhhmm, ' mn' 143 IF(lwp) WRITE(numout,*) ' nb of seconds per minute rmmss = ', rmmss, ' s' 144 145 IF(lwp) WRITE(numout,*) 146 IF(lwp) WRITE(numout,*) ' earth radius ra = ', ra, ' m' 147 IF(lwp) WRITE(numout,*) ' gravity grav = ', grav , ' m/s^2' 148 149 IF(lwp) WRITE(numout,*) 150 IF(lwp) WRITE(numout,*) ' triple point of temperature rtt = ', rtt , ' K' 151 IF(lwp) WRITE(numout,*) ' freezing point of water rt0 = ', rt0 , ' K' 152 IF(lwp) WRITE(numout,*) ' melting point of snow rt0_snow = ', rt0_snow, ' K' 153 IF(lwp) WRITE(numout,*) ' melting point of ice rt0_ice = ', rt0_ice , ' K' 154 155 ro0cpr = 1. / ( rau0 * rcp ) 156 IF(lwp) WRITE(numout,*) 157 IF(lwp) WRITE(numout,*) ' volumic mass of pure water rauw = ', rauw, ' kg/m^3' 158 IF(lwp) WRITE(numout,*) ' volumic mass of reference rau0 = ', rau0, ' kg/m^3' 159 IF(lwp) WRITE(numout,*) ' ocean specific heat rcp = ', rcp 160 IF(lwp) WRITE(numout,*) ' 1. / ( rau0 * rcp ) = ro0cpr = ', ro0cpr 161 162 IF(lwp) THEN 123 WRITE(numout,*) 124 WRITE(numout,*) ' Constants' 125 WRITE(numout,*) 126 WRITE(numout,*) ' mathematical constant rpi = ', rpi 127 WRITE(numout,*) ' day rday = ', rday, ' s' 128 WRITE(numout,*) ' sideral year rsiyea = ', rsiyea, ' s' 129 WRITE(numout,*) ' sideral day rsiday = ', rsiday, ' s' 130 WRITE(numout,*) ' omega omega = ', omega, ' s-1' 131 WRITE(numout,*) 132 WRITE(numout,*) ' nb of months per year raamo = ', raamo, ' months' 133 WRITE(numout,*) ' nb of hours per day rjjhh = ', rjjhh, ' hours' 134 WRITE(numout,*) ' nb of minutes per hour rhhmm = ', rhhmm, ' mn' 135 WRITE(numout,*) ' nb of seconds per minute rmmss = ', rmmss, ' s' 136 WRITE(numout,*) 137 WRITE(numout,*) ' earth radius ra = ', ra, ' m' 138 WRITE(numout,*) ' gravity grav = ', grav , ' m/s^2' 139 WRITE(numout,*) 140 WRITE(numout,*) ' triple point of temperature rtt = ', rtt , ' K' 141 WRITE(numout,*) ' freezing point of water rt0 = ', rt0 , ' K' 142 WRITE(numout,*) ' melting point of snow rt0_snow = ', rt0_snow, ' K' 143 WRITE(numout,*) ' melting point of ice rt0_ice = ', rt0_ice , ' K' 144 WRITE(numout,*) 145 WRITE(numout,*) ' ocean reference volumic mass rau0 = ', rau0 , ' kg/m^3' 146 WRITE(numout,*) ' ocean reference specific volume rau0r = ', rau0r, ' m^3/Kg' 147 WRITE(numout,*) ' ocean specific heat rcp = ', rcp 148 WRITE(numout,*) ' 1. / ( rau0 * rcp ) = ro0cpr = ', ro0cpr 163 149 WRITE(numout,*) 164 150 WRITE(numout,*) ' thermal conductivity of the snow = ', rcdsn , ' J/s/m/K' … … 184 170 WRITE(numout,*) ' von Karman constant = ', vkarmn 185 171 WRITE(numout,*) ' Stefan-Boltzmann constant = ', stefan , ' J/s/m^2/K^4' 186 187 172 WRITE(numout,*) 188 173 WRITE(numout,*) ' conversion: degre ==> radian rad = ', rad 189 190 174 WRITE(numout,*) 191 175 WRITE(numout,*) ' smallest real computer value rsmall = ', rsmall -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
r1152 r2007 123 123 124 124 #if defined key_obc 125 #if defined key_agrif 126 IF (Agrif_Root() ) THEN 127 #endif 128 ! open boundaries (div must be zero behind the open boundary) 129 ! mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 130 IF( lp_obc_east ) hdivn(nie0p1:nie1p1,nje0 :nje1 ,jk) = 0.e0 ! east 131 IF( lp_obc_west ) hdivn(niw0 :niw1 ,njw0 :njw1 ,jk) = 0.e0 ! west 132 IF( lp_obc_north ) hdivn(nin0 :nin1 ,njn0p1:njn1p1,jk) = 0.e0 ! north 133 IF( lp_obc_south ) hdivn(nis0 :nis1 ,njs0 :njs1 ,jk) = 0.e0 ! south 134 #if defined key_agrif 135 ENDIF 136 #endif 125 IF( Agrif_Root() ) THEN 126 ! open boundaries (div must be zero behind the open boundary) 127 ! mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 128 IF( lp_obc_east ) hdivn(nie0p1:nie1p1,nje0 :nje1 ,jk) = 0.e0 ! east 129 IF( lp_obc_west ) hdivn(niw0 :niw1 ,njw0 :njw1 ,jk) = 0.e0 ! west 130 IF( lp_obc_north ) hdivn(nin0 :nin1 ,njn0p1:njn1p1,jk) = 0.e0 ! north 131 IF( lp_obc_south ) hdivn(nis0 :nis1 ,njs0 :njs1 ,jk) = 0.e0 ! south 132 ENDIF 137 133 #endif 138 134 #if defined key_bdy 139 135 ! unstructured open boundaries (div must be zero behind the open boundary) 140 136 DO jj = 1, jpj 141 DO ji = 1, jpi142 hdivn(ji,jj,jk)=hdivn(ji,jj,jk)*bdytmask(ji,jj)143 END DO137 DO ji = 1, jpi 138 hdivn(ji,jj,jk)=hdivn(ji,jj,jk)*bdytmask(ji,jj) 139 END DO 144 140 END DO 145 141 #endif 146 #if defined key_agrif 147 if ( .NOT. AGRIF_Root() ) then 148 IF ((nbondi == 1).OR.(nbondi == 2)) hdivn(nlci-1 , : ,jk) = 0.e0 ! east 149 IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2 , : ,jk) = 0.e0 ! west 150 IF ((nbondj == 1).OR.(nbondj == 2)) hdivn(: ,nlcj-1 ,jk) = 0.e0 ! north 151 IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(: ,2 ,jk) = 0.e0 ! south 152 endif 153 #endif 142 IF( .NOT. AGRIF_Root() ) THEN 143 IF ((nbondi == 1).OR.(nbondi == 2)) hdivn(nlci-1 , : ,jk) = 0.e0 ! east 144 IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2 , : ,jk) = 0.e0 ! west 145 IF ((nbondj == 1).OR.(nbondj == 2)) hdivn(: ,nlcj-1 ,jk) = 0.e0 ! north 146 IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(: ,2 ,jk) = 0.e0 ! south 147 ENDIF 154 148 155 149 ! ! -------- … … 341 335 342 336 #if defined key_obc 343 #if defined key_agrif 344 IF ( Agrif_Root() ) THEN 345 #endif 346 ! open boundaries (div must be zero behind the open boundary) 347 ! mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 348 IF( lp_obc_east ) hdivn(nie0p1:nie1p1,nje0 :nje1 ,jk) = 0.e0 ! east 349 IF( lp_obc_west ) hdivn(niw0 :niw1 ,njw0 :njw1 ,jk) = 0.e0 ! west 350 IF( lp_obc_north ) hdivn(nin0 :nin1 ,njn0p1:njn1p1,jk) = 0.e0 ! north 351 IF( lp_obc_south ) hdivn(nis0 :nis1 ,njs0 :njs1 ,jk) = 0.e0 ! south 352 #if defined key_agrif 353 ENDIF 354 #endif 337 IF( Agrif_Root() ) THEN 338 ! open boundaries (div must be zero behind the open boundary) 339 ! mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 340 IF( lp_obc_east ) hdivn(nie0p1:nie1p1,nje0 :nje1 ,jk) = 0.e0 ! east 341 IF( lp_obc_west ) hdivn(niw0 :niw1 ,njw0 :njw1 ,jk) = 0.e0 ! west 342 IF( lp_obc_north ) hdivn(nin0 :nin1 ,njn0p1:njn1p1,jk) = 0.e0 ! north 343 IF( lp_obc_south ) hdivn(nis0 :nis1 ,njs0 :njs1 ,jk) = 0.e0 ! south 344 ENDIF 355 345 #endif 356 346 #if defined key_bdy … … 362 352 END DO 363 353 #endif 364 #if defined key_agrif 365 if ( .NOT. AGRIF_Root() ) then 354 IF( .NOT. AGRIF_Root() ) THEN 366 355 IF ((nbondi == 1).OR.(nbondi == 2)) hdivn(nlci-1 , : ,jk) = 0.e0 ! east 367 356 IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2 , : ,jk) = 0.e0 ! west 368 357 IF ((nbondj == 1).OR.(nbondj == 2)) hdivn(: ,nlcj-1 ,jk) = 0.e0 ! north 369 358 IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(: ,2 ,jk) = 0.e0 ! south 370 endif 371 #endif 359 ENDIF 372 360 373 361 ! ! -------- -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r1740 r2007 146 146 # if defined key_obc 147 147 ! !* OBC open boundaries 148 CALL obc_dyn( kt )148 IF( lk_obc ) CALL obc_dyn( kt ) 149 149 ! 150 150 IF ( lk_dynspg_exp .OR. lk_dynspg_ts ) THEN -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r1739 r2007 186 186 187 187 #if defined key_obc 188 CALL obc_dyn( kt )! Update velocities on each open boundary with the radiation algorithm189 CALL obc_vol( kt )! Correction of the barotropic componant velocity to control the volume of the system188 IF( lk_obc ) CALL obc_dyn( kt ) ! Update velocities on each open boundary with the radiation algorithm 189 IF( lk_obc ) CALL obc_vol( kt ) ! Correction of the barotropic componant velocity to control the volume of the system 190 190 #endif 191 191 #if defined key_bdy … … 315 315 #if defined key_obc 316 316 ! caution : grad D = 0 along open boundaries 317 spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj) 318 spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj) 317 IF( Agrif_Root() ) THEN 318 spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj) 319 spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj) 320 ELSE 321 spgu(ji,jj) = z2dt * ztdgu 322 spgv(ji,jj) = z2dt * ztdgv 323 ENDIF 319 324 #elif defined key_bdy 320 325 ! caution : grad D = 0 along open boundaries -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r1756 r2007 157 157 158 158 #if defined key_obc 159 # if defined key_agrif160 159 IF ( Agrif_Root() ) THEN 161 # endif162 160 ssha(:,:) = ssha(:,:) * obctmsk(:,:) 163 161 CALL lbc_lnk( ssha, 'T', 1. ) ! absolutly compulsory !! (jmm) 164 # if defined key_agrif 165 ENDIF 166 # endif 162 ENDIF 167 163 #endif 168 164 -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r1743 r2007 43 43 LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .FALSE. !: iom_put flag 44 44 #endif 45 PUBLIC iom_init, iom_ open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put45 PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 46 46 47 47 PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d … … 86 86 !!---------------------------------------------------------------------- 87 87 ! read the xml file 88 CALL event__parse_xml_file( 'iodef.xml' ) ! <- to get from the nameliste (namrun)... 88 IF( Agrif_Root() ) CALL event__parse_xml_file( 'iodef.xml' ) ! <- to get from the nameliste (namrun)... 89 CALL iom_swap 89 90 90 91 ! calendar parameters … … 119 120 120 121 END SUBROUTINE iom_init 122 123 124 SUBROUTINE iom_swap 125 !!--------------------------------------------------------------------- 126 !! *** SUBROUTINE iom_swap *** 127 !! 128 !! ** Purpose : swap context between different agrif grid for xmlio_server 129 !!--------------------------------------------------------------------- 130 #if defined key_iomput 131 132 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 133 CALL event__swap_context("nemo") 134 ELSE 135 CALL event__swap_context(TRIM(Agrif_CFixed())//"_nemo") 136 ENDIF 137 138 #endif 139 END SUBROUTINE iom_swap 121 140 122 141 … … 164 183 ! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0 165 184 ! (could be done when defining iom_file in f95 but not in f90) 166 #if ! defined key_agrif167 IF( iom_open_init == 0 ) THEN168 iom_file(:)%nfid = 0169 iom_open_init = 1170 ENDIF171 #else172 185 IF( Agrif_Root() ) THEN 173 186 IF( iom_open_init == 0 ) THEN … … 176 189 ENDIF 177 190 ENDIF 178 #endif179 191 ! do we read or write the file? 180 192 IF( PRESENT(ldwrt) ) THEN ; llwrt = ldwrt … … 199 211 ! ============= 200 212 clname = trim(cdname) 201 #if defined key_agrif202 213 IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN 203 214 iln = INDEX(clname,'/') … … 206 217 clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname) 207 218 ENDIF 208 #endif209 219 ! which suffix should we use? 210 220 SELECT CASE (iolib) -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/OBC/obc_oce.F90
r1601 r2007 27 27 ! 28 28 ! !!* Namelist namobc: open boundary condition * 29 INTEGER :: nn_nbobc = 2 !: number of open boundaries ( 1=< nbobc =< 4 )30 29 INTEGER :: nn_obcdta = 0 !: = 0 use the initial state as obc data 31 30 ! ! = 1 read obc data in obcxxx.dta files -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par.F90
r1647 r2007 25 25 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 26 26 !!---------------------------------------------------------------------- 27 LOGICAL, PUBLIC, PARAMETER :: lk_obc = .TRUE. !: Ocean Boundary Condition flag 27 #if ! defined key_agrif 28 LOGICAL, PUBLIC, PARAMETER :: lk_obc = .TRUE. !: Ocean Boundary Condition flag 29 #else 30 LOGICAL, PUBLIC :: lk_obc = .TRUE. !: Ocean Boundary Condition flag 31 #endif 28 32 29 33 # if defined key_eel_r5 … … 43 47 !! open boundary parameter 44 48 !!--------------------------------------------------------------------- 45 INTEGER , PARAMETER:: & !: time dimension of the BCS fields on input49 INTEGER :: & !: time dimension of the BCS fields on input 46 50 jptobc = 2 47 51 !! * EAST open boundary 48 LOGICAL , PARAMETER:: & !:52 LOGICAL :: & !: 49 53 lp_obc_east = .FALSE. !: to active or not the East open boundary 50 INTEGER , PARAMETER :: & !:54 INTEGER :: & 51 55 jpieob = jpiglo-2, & !: i-localization of the East open boundary (must be ocean U-point) 52 56 jpjed = 2, & !: j-starting indice of the East open boundary (must be land T-point) … … 56 60 57 61 !! * WEST open boundary 58 LOGICAL , PARAMETER:: & !:62 LOGICAL :: & !: 59 63 lp_obc_west = .FALSE. !: to active or not the West open boundary 60 INTEGER , PARAMETER:: & !:64 INTEGER :: & !: 61 65 jpiwob = 2, & !: i-localization of the West open boundary (must be ocean U-point) 62 66 jpjwd = 2, & !: j-starting indice of the West open boundary (must be land T-point) … … 66 70 67 71 !! * NORTH open boundary 68 LOGICAL , PARAMETER:: & !:72 LOGICAL :: & !: 69 73 lp_obc_north = .FALSE. !: to active or not the North open boundary 70 INTEGER , PARAMETER:: & !:74 INTEGER :: & !: 71 75 jpjnob = jpjglo-2, & !: j-localization of the North open boundary (must be ocean V-point) 72 76 jpind = 2, & !: i-starting indice of the North open boundary (must be land T-point) … … 76 80 77 81 !! * SOUTH open boundary 78 LOGICAL , PARAMETER:: & !:82 LOGICAL :: & !: 79 83 lp_obc_south = .FALSE. !: to active or not the South open boundary 80 INTEGER , PARAMETER:: & !:84 INTEGER :: & !: 81 85 jpjsob = 2, & !: j-localization of the South open boundary (must be ocean V-point) 82 86 jpisd = 2, & !: i-starting indice of the South open boundary (must be land T-point) -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par_EEL_R5.h90
r1152 r2007 15 15 LOGICAL, PARAMETER :: & !: 16 16 lp_obc_east = .TRUE. !: to active or not the East open boundary 17 INTEGER, PARAMETER :: & !: 17 18 INTEGER & 19 #if !defined key_agrif 20 , PARAMETER & 21 #endif 22 :: & 18 23 jpieob = jpiglo-2, & !: i-localization of the East open boundary (must be ocean U-point) 19 24 jpjed = 2, & !: j-starting indice of the East open boundary (must be land T-point) … … 25 30 LOGICAL, PARAMETER :: & !: 26 31 lp_obc_west = .TRUE. !: to active or not the West open boundary 27 INTEGER, PARAMETER :: & 32 33 INTEGER & 34 #if !defined key_agrif 35 , PARAMETER & 36 #endif 37 :: & 28 38 jpiwob = 2, & !: i-localization of the West open boundary (must be ocean U-point) 29 39 jpjwd = 2, & !: j-starting indice of the West open boundary (must be land T-point) … … 35 45 LOGICAL, PARAMETER :: & !: 36 46 lp_obc_north = .FALSE. !: to active or not the North open boundary 37 INTEGER, PARAMETER :: & !: 47 48 INTEGER & 49 #if !defined key_agrif 50 , PARAMETER & 51 #endif 52 :: & 38 53 jpjnob = jpjglo-2, & !: j-localization of the North open boundary (must be ocean V-point) 39 54 jpind = 2, & !: i-starting indice of the North open boundary (must be land T-point) … … 45 60 LOGICAL, PARAMETER :: & !: 46 61 lp_obc_south = .FALSE. !: to active or not the South open boundary 47 INTEGER, PARAMETER :: & !: 62 63 INTEGER & 64 #if !defined key_agrif 65 , PARAMETER & 66 #endif 67 :: & 48 68 jpjsob = 2, & !: j-localization of the South open boundary (must be ocean V-point) 49 69 jpisd = 2, & !: i-starting indice of the South open boundary (must be land T-point) -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par_POMME_R025.h90
r1648 r2007 4 4 !! open boundary parameter : POMME configuration 5 5 !!--------------------------------------------------------------------- 6 INTEGER, PARAMETER :: & !: time dimension of the BCS fields on input7 jptobc = 146 INTEGER, PARAMETER :: jptobc = 14 7 !: time dimension of the BCS fields on input 8 8 9 9 !! * EAST open boundary 10 10 LOGICAL, PARAMETER :: & !: 11 11 lp_obc_east = .TRUE. !: 12 INTEGER, PARAMETER :: & !:13 12 13 INTEGER & 14 #if !defined key_agrif 15 , PARAMETER & 16 #endif 17 :: & 14 18 ! * default values * 15 19 !jpieob = jpiglo-2, & !: i-localization of the East open boundary (must be ocean U-point) 16 20 !jpjed = 2, & !: j-starting indice of the East open boundary (must be land T-point) 17 21 !jpjef = jpjglo-1, & !: j-ending indice of the East open boundary (must be land T-point) 18 19 22 jpieob = jpiglo-2, & !: i-localization of the East open boundary (must be ocean U-point) 20 23 jpjed = 1, & !: j-starting indice of the East open boundary (must be land T-point) 21 24 jpjef = jpjglo, & !: j-ending indice of the East open boundary (must be land T-point) 22 23 25 jpjedp1 = jpjed+1, & !: first ocean point " " 24 26 jpjefm1 = jpjef-1 !: last ocean point " " … … 27 29 LOGICAL, PARAMETER :: & !: 28 30 lp_obc_west = .TRUE. !: to active or not the West open boundary 29 INTEGER, PARAMETER :: & !:30 31 32 INTEGER & 33 #if !defined key_agrif 34 , PARAMETER & 35 #endif 36 :: & 31 37 ! * default values * 32 38 !jpiwob = 2, & !: i-localization of the West open boundary (must be ocean U-point) 33 39 !jpjwd = 2, & !: j-starting indice of the West open boundary (must be land T-point) 34 40 !jpjwf = jpjglo-1, & !: j-ending indice of the West open boundary (must be land T-point) 35 36 41 jpiwob = 2, & !: i-localization of the West open boundary (must be ocean U-point) 37 42 jpjwd = 1, & !: j-starting indice of the West open boundary (must be land T-point) 38 43 jpjwf = jpjglo, & !: j-ending indice of the West open boundary (must be land T-point) 39 40 44 jpjwdp1 = jpjwd+1, & !: first ocean point " " 41 45 jpjwfm1 = jpjwf-1 !: last ocean point " " … … 44 48 LOGICAL, PARAMETER :: & !: 45 49 lp_obc_north = .TRUE. !: 46 INTEGER, PARAMETER :: & !:47 50 51 INTEGER & 52 #if !defined key_agrif 53 , PARAMETER & 54 #endif 55 :: & 48 56 ! * default values * 49 57 !jpjnob = jpjglo-2, & !: j-localization of the North open boundary (must be ocean V-point) 50 58 !jpind = 2, & !: i-starting indice of the North open boundary (must be land T-point) 51 59 !jpinf = jpiglo-1, & !: i-ending indice of the North open boundary (must be land T-point) 52 53 60 jpjnob = jpjglo-2, & !: j-localization of the North open boundary (must be ocean V-point) 54 61 jpind = 1, & !: i-starting indice of the North open boundary (must be land T-point) 55 62 jpinf = jpiglo, & !: i-ending indice of the North open boundary (must be land T-point) 56 57 63 jpindp1 = jpind+1, & !: first ocean point " " 58 64 jpinfm1 = jpinf-1 !: last ocean point " " … … 61 67 LOGICAL, PARAMETER :: & !: 62 68 lp_obc_south = .TRUE. !: INDICE to active or not the South open boundary 63 INTEGER, PARAMETER :: & !:64 69 70 INTEGER & 71 #if !defined key_agrif 72 , PARAMETER & 73 #endif 74 :: & 65 75 ! * default values * 66 76 !jpjsob = 2, & !: j-localization of the South open boundary (must be ocean V-point) 67 77 !jpisd = 2, & !: i-starting indice of the South open boundary (must be land T-point) 68 78 !jpisf = jpiglo-1, & !: i-ending indice of the South open boundary (must be land T-point) 69 70 79 jpjsob = 2, & !: j-localization of the South open boundary (must be ocean V-point) 71 80 jpisd = 1, & !: i-starting indice of the South open boundary (must be land T-point) 72 81 jpisf = jpiglo, & !: i-ending indice of the South open boundary (must be land T-point) 73 74 82 jpisdp1 = jpisd+1, & !: first ocean point " " 75 83 jpisfm1 = jpisf-1 !: last ocean point " " -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90
r1732 r2007 469 469 ENDIF 470 470 ELSE 471 #if defined key_agrif 472 IF ( ASSOCIATED(ztcobc) ) DEALLOCATE ( ztcobc ) 473 #else 471 474 IF ( ALLOCATED(ztcobc) ) DEALLOCATE ( ztcobc ) 475 #endif 472 476 ALLOCATE (ztcobc(itobc)) 473 477 DO ji=1,1 ! use a dummy loop to read ztcobc only once -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/OBC/obcfla.F90
r1152 r2007 82 82 83 83 DO ji = nie0, nie1 84 DO jk = 1, jpkm1 85 DO jj = 1, jpj 86 ua_e(ji,jj) = ( ubtfoe(jj) + sqrt( grav*hu(ji,jj) ) & 87 & * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5 & 88 & - sshfoe(jj) ) ) * uemsk(jj,jk) 89 END DO 84 DO jj = 1, jpj 85 ua_e(ji,jj) = ( ubtfoe(jj) * hur(ji,jj) + sqrt( grav*hur(ji,jj) ) & 86 & * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5 & 87 & - sshfoe(jj) ) ) * uemsk(jj,jk) 90 88 END DO 91 89 END DO … … 97 95 ssha_e(ji,jj) = ssha_e(ji,jj) * ( 1. - temsk(jj,1) ) & 98 96 & + temsk(jj,1) * sshfoe(jj) 99 va_e(ji,jj) = vbtfoe(jj) * uemsk(jj,jk)97 va_e(ji,jj) = vbtfoe(jj) * hvr(ji,jj) * uemsk(jj,jk) 100 98 END DO 101 99 END DO … … 120 118 121 119 DO ji = niw0, niw1 122 DO jk = 1, jpkm1 123 DO jj = 1, jpj 124 ua_e(ji,jj) = ( ubtfow(jj) - sqrt( grav * hu(ji,jj) ) & 125 & * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5 & 126 & - sshfow(jj) ) ) * uwmsk(jj,jk) 127 va_e(ji,jj) = vbtfow(jj) * uwmsk(jj,jk) 128 END DO 120 DO jj = 1, jpj 121 ua_e(ji,jj) = ( ubtfow(jj) * hur(ji,jj) - sqrt( grav * hur(ji,jj) ) & 122 & * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5 & 123 & - sshfow(jj) ) ) * uwmsk(jj,jk) 124 va_e(ji,jj) = vbtfow(jj) * hvr(ji,jj) * uwmsk(jj,jk) 129 125 END DO 130 126 DO jj = 1, jpj … … 155 151 156 152 DO jj = njn0, njn1 157 DO jk = 1, jpkm1 158 DO ji = 1, jpi 159 va_e(ji,jj) = ( vbtfon(ji) + sqrt( grav * hv(ji,jj) ) & 160 & * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5 & 161 & - sshfon(ji) ) ) * vnmsk(ji,jk) 162 END DO 153 DO ji = 1, jpi 154 va_e(ji,jj) = ( vbtfon(ji) * hvr(ji,jj) + sqrt( grav * hvr(ji,jj) ) & 155 & * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5 & 156 & - sshfon(ji) ) ) * vnmsk(ji,jk) 163 157 END DO 164 158 END DO … … 170 164 ssha_e(ji,jj) = ssha_e(ji,jj) * ( 1. - tnmsk(ji,1) ) & 171 165 & + sshfon(ji) * tnmsk(ji,1) 172 ua_e(ji,jj) = ubtfon(ji) * vnmsk(ji,jk)166 ua_e(ji,jj) = ubtfon(ji) * hur(ji,jj) * vnmsk(ji,jk) 173 167 END DO 174 168 END DO … … 193 187 194 188 DO jj = njs0, njs1 195 DO jk = 1, jpkm1 196 DO ji = 1, jpi 197 va_e(ji,jj) = ( vbtfos(ji) - sqrt( grav * hv(ji,jj) ) & 198 & * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5 & 199 & - sshfos(ji) ) ) * vsmsk(ji,jk) 200 ua_e(ji,jj) = ubtfos(ji) * vsmsk(ji,jk) 201 END DO 189 DO ji = 1, jpi 190 va_e(ji,jj) = ( vbtfos(ji) * hvr(ji,jj) - sqrt( grav * hvr(ji,jj) ) & 191 & * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5 & 192 & - sshfos(ji) ) ) * vsmsk(ji,jk) 193 ua_e(ji,jj) = ubtfos(ji) * hur(ji,jj) * vsmsk(ji,jk) 202 194 END DO 203 195 DO ji = 1, jpi -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/OBC/obcini.F90
r1633 r2007 70 70 71 71 ! convert DOCTOR namelist name into the OLD names 72 nbobc = nn_nbobc73 72 nobc_dta = nn_obcdta 74 73 cffile = cn_obcdta … … 101 100 IF(lwp) WRITE(numout,*) 'obc_init : initialization of open boundaries' 102 101 IF(lwp) WRITE(numout,*) '~~~~~~~~' 103 IF(lwp) WRITE(numout,*) ' Number of open boundaries n n_nbobc = ', nn_nbobc102 IF(lwp) WRITE(numout,*) ' Number of open boundaries nbobc = ', nbobc 104 103 IF(lwp) WRITE(numout,*) 105 104 … … 306 305 IF( lp_obc_east ) THEN 307 306 !... (jpjed,jpjefm1),jpieob 307 bmask(nie0p1:nie1p1,nje0:nje1m1) = 0.e0 308 308 309 309 ! ... initilization to zero … … 341 341 IF( lp_obc_north ) THEN 342 342 ! ... jpjnob,(jpind,jpisfm1) 343 bmask(nin0:nin1m1,njn0p1:njn1p1) = 0.e0 343 344 344 345 ! ... initilization to zero … … 440 441 END DO 441 442 END IF 442 443 443 444 IF( lp_obc_north ) THEN ! ... North open boundary lateral surface 444 445 DO jj = njn0, njn1 -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90
r1715 r2007 96 96 ! ------------- 97 97 98 CALL ctl_opn( inum, 'restart.obc.output', ' REPLACE', 'UNFORMATTED', 'DIRECT', nreclo, numout, lwp )98 CALL ctl_opn( inum, 'restart.obc.output', 'UNKNOWN', 'UNFORMATTED', 'DIRECT', nreclo, numout, lwp ) 99 99 100 100 ! 1.2 Write header … … 322 322 ! 0.1 Open files 323 323 ! --------------- 324 CALL ctl_opn( inum, 'restart.obc', ' REPLACE', 'UNFORMATTED', 'DIRECT', nreclo, numout, lwp )324 CALL ctl_opn( inum, 'restart.obc', 'UNKNOWN', 'UNFORMATTED', 'DIRECT', nreclo, numout, lwp ) 325 325 326 326 ! 1. Read -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r1730 r2007 184 184 & nday + 1 - nmonth_len(nmonth) * COUNT((/llnxtmth/)), llstop ) 185 185 186 IF( sd(jf)%num == 0 .AND. .NOT. llstop ) THEN ! next year file does not exist186 IF( sd(jf)%num <= 0 .AND. .NOT. llstop ) THEN ! next year file does not exist 187 187 CALL ctl_warn('next year/month/day file: '//TRIM(sd(jf)%clname)// & 188 188 & ' not present -> back to current year/month/day') … … 368 368 369 369 ! if previous year/month/day file does not exist, we switch to the current year/month/day 370 IF( llprev .AND. sdjf%num == 0 ) THEN370 IF( llprev .AND. sdjf%num <= 0 ) THEN 371 371 CALL ctl_warn( 'previous year/month/day file: '//TRIM(sdjf%clname)//' not present -> back to current year/month/day') 372 372 ! we force to read the first record of the current year/month/day instead of last record of previous year/month/day … … 399 399 ENDIF 400 400 401 IF( sdjf%num == 0 ) CALL fld_clopn( sdjf, nyear, nmonth, nday ) ! make sure current year/month/day file is opened401 IF( sdjf%num <= 0 ) CALL fld_clopn( sdjf, nyear, nmonth, nday ) ! make sure current year/month/day file is opened 402 402 403 403 sdjf%nswap_sec = nsec_year + nsec1jan000 - 1 ! force read/update the after data in the following part of fld_read … … 815 815 WRITE(aname,'(a3,i2.2)') 'src',jn 816 816 data_tmp(:,:) = 0 817 CALL iom_get ( inum, jpdom_unknown, aname, data_tmp(1:nlci,1:nlcj), & 818 kstart=(/nimpp,njmpp/), kcount=(/nlci,nlcj/) ) 817 CALL iom_get ( inum, jpdom_data, aname, data_tmp(:,:) ) 819 818 data_src(:,:) = INT(data_tmp(:,:)) 820 819 ref_wgts(nxt_wgt)%data_jpj(:,:,jn) = 1 + (data_src(:,:)-1) / ref_wgts(nxt_wgt)%ddims(1) … … 825 824 aname = ' ' 826 825 WRITE(aname,'(a3,i2.2)') 'wgt',jn 827 ref_wgts(nxt_wgt)%data_wgt(1:nlci,1:nlcj,jn) = 0.0 828 CALL iom_get ( inum, jpdom_unknown, aname, ref_wgts(nxt_wgt)%data_wgt(1:nlci,1:nlcj,jn), & 829 kstart=(/nimpp,njmpp/), kcount=(/nlci,nlcj/) ) 826 ref_wgts(nxt_wgt)%data_wgt(:,:,jn) = 0.0 827 CALL iom_get ( inum, jpdom_data, aname, ref_wgts(nxt_wgt)%data_wgt(:,:,jn) ) 830 828 END DO 831 829 CALL iom_close (inum) 832 830 833 831 ! find min and max indices in grid 834 ref_wgts(nxt_wgt)%botleft(1) = MINVAL(ref_wgts(nxt_wgt)%data_jpi( 1:nlci,1:nlcj,:))835 ref_wgts(nxt_wgt)%botleft(2) = MINVAL(ref_wgts(nxt_wgt)%data_jpj( 1:nlci,1:nlcj,:))836 ref_wgts(nxt_wgt)%topright(1) = MAXVAL(ref_wgts(nxt_wgt)%data_jpi( 1:nlci,1:nlcj,:))837 ref_wgts(nxt_wgt)%topright(2) = MAXVAL(ref_wgts(nxt_wgt)%data_jpj( 1:nlci,1:nlcj,:))832 ref_wgts(nxt_wgt)%botleft(1) = MINVAL(ref_wgts(nxt_wgt)%data_jpi(:,:,:)) 833 ref_wgts(nxt_wgt)%botleft(2) = MINVAL(ref_wgts(nxt_wgt)%data_jpj(:,:,:)) 834 ref_wgts(nxt_wgt)%topright(1) = MAXVAL(ref_wgts(nxt_wgt)%data_jpi(:,:,:)) 835 ref_wgts(nxt_wgt)%topright(2) = MAXVAL(ref_wgts(nxt_wgt)%data_jpj(:,:,:)) 838 836 839 837 ! and therefore dimensions of the input box -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
r1613 r2007 311 311 312 312 ! lateral boundary cond.: T-, U-, V-, F-pts, sgn 313 CALL lbc_lnk( gcost, 'T', 1. ) ; CALL lbc_lnk( gsint, 'T', -1. )314 CALL lbc_lnk( gcosu, 'U', 1. ) ; CALL lbc_lnk( gsinu, 'U', -1. )315 CALL lbc_lnk( gcosv, 'V', 1. ) ; CALL lbc_lnk( gsinv, 'V', -1. )316 CALL lbc_lnk( gcosf, 'F', 1. ) ; CALL lbc_lnk( gsinf, 'F', -1. )313 CALL lbc_lnk( gcost, 'T', -1. ) ; CALL lbc_lnk( gsint, 'T', -1. ) 314 CALL lbc_lnk( gcosu, 'U', -1. ) ; CALL lbc_lnk( gsinu, 'U', -1. ) 315 CALL lbc_lnk( gcosv, 'V', -1. ) ; CALL lbc_lnk( gsinv, 'V', -1. ) 316 CALL lbc_lnk( gcosf, 'F', -1. ) ; CALL lbc_lnk( gsinf, 'F', -1. ) 317 317 318 318 END SUBROUTINE angle -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r1766 r2007 23 23 USE sbc_oce ! Surface boundary condition: ocean fields 24 24 USE sbc_ice ! Surface boundary condition: ice fields 25 USE phycst ! physical constants 25 26 #if defined key_lim3 26 27 USE par_ice ! ice parameters … … 45 46 USE lib_mpp ! distribued memory computing library 46 47 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 47 USE phycst, ONLY : xlsn, rhosn, xlic, rhoic48 48 #if defined key_cpl_carbon_cycle 49 49 USE p4zflx, ONLY : oce_co2 … … 274 274 srcv(jpr_itz2)%clname = 'O_ITauz2' ! 3rd - - - - 275 275 ! 276 srcv(jpr_otx1:jpr_itz2)%nsgn = -1 ! Vectors: change of sign at north fold 276 ! Vectors: change of sign at north fold ONLY if on the local grid 277 IF( TRIM( cn_rcv_tau(3) ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 277 278 278 279 ! ! Set grid and action … … 714 715 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(:,:,jpr_qnsoce) 715 716 IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(:,:,jpr_qnsmix) 716 ! energy for melting solid precipitation over free ocean 717 zcoef = xlsn / rhosn 718 qns(:,:) = qns(:,:) - frcv(:,:,jpr_snow) * zcoef 717 qns(:,:) = qns(:,:) - frcv(:,:,jpr_snow) * lfus ! add the latent heat of solid precip. melting 718 719 719 ! ! solar flux over the ocean (qsr) 720 720 IF( srcv(jpr_qsroce)%laction ) qsr(:,:) = frcv(:,:,jpr_qsroce) … … 1117 1117 & + pist(:,:,1) * zicefr(:,:,1) ) ) 1118 1118 END SELECT 1119 ! ! snow melting heat flux .... 1120 ! energy for melting solid precipitation over ice-free ocean 1121 zcoef = xlsn / rhosn 1122 ztmp(:,:) = p_frld(:,:,1) * zsnow(:,:) * zcoef 1123 pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:) 1119 ztmp(:,:) = p_frld(:,:,1) * zsnow(:,:) * lfus ! add the latent heat of solid precip. melting 1120 pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:) ! over free ocean 1124 1121 IF( lk_diaar5 ) CALL iom_put( 'hflx_snow_cea', ztmp + zsnow(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1125 1122 !!gm … … 1130 1127 !! 1131 1128 !! similar job should be done for snow and precipitation temperature 1132 ! ! Iceberg melting heat flux .... 1133 ! energy for iceberg melting 1134 IF( srcv(jpr_cal)%laction ) THEN 1135 zcoef = xlic / rhoic 1136 ztmp(:,:) = frcv(:,:,jpr_cal) * zcoef 1129 ! 1130 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1131 ztmp(:,:) = frcv(:,:,jpr_cal) * lfus ! add the latent heat of iceberg melting 1137 1132 pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:) 1138 1133 IF( lk_diaar5 ) CALL iom_put( 'hflx_cal_cea', ztmp + frcv(:,:,jpr_cal) * zcptn(:,:) ) ! heat flux from calving -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
r1715 r2007 65 65 INTEGER :: inum ! temporary logical unit 66 66 INTEGER :: ikty, iyear ! 67 REAL(wp) :: z_emp, z_emp_nsrf ! temporary scalars67 REAL(wp) :: z_emp, z_emp_nsrf, zsum_emp, zsum_erp ! temporary scalars 68 68 REAL(wp) :: zsurf_neg, zsurf_pos, zsurf_tospread 69 69 REAL(wp), DIMENSION(jpi,jpj) :: ztmsk_neg, ztmsk_pos, ztmsk_tospread … … 165 165 ! 166 166 IF( lk_mpp ) CALL mpp_sum( z_emp ) 167 IF( lk_mpp ) CALL mpp_sum( zsurf_neg ) 168 IF( lk_mpp ) CALL mpp_sum( zsurf_pos ) 167 169 168 170 IF( z_emp < 0.e0 ) THEN … … 177 179 178 180 ! emp global mean over <0 or >0 erp area 179 z_emp_nsrf = SUM( e1e2_i(:,:) * z_emp ) / ( zsurf_tospread + rsmall ) 181 zsum_emp = SUM( e1e2_i(:,:) * z_emp ) 182 IF( lk_mpp ) CALL mpp_sum( zsum_emp ) 183 z_emp_nsrf = zsum_emp / ( zsurf_tospread + rsmall ) 180 184 ! weight to respect erp field 2D structure 181 z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( SUM( ztmsk_tospread(:,:) * erp(:,:) * e1e2_i(:,:) ) + rsmall ) 185 zsum_erp = SUM( ztmsk_tospread(:,:) * erp(:,:) * e1e2_i(:,:) ) 186 IF( lk_mpp ) CALL mpp_sum( zsum_erp ) 187 z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall ) 188 182 189 ! final correction term to apply 183 190 zerp_cor(:,:) = -1. * z_emp_nsrf * zsurf_tospread * z_wgt(:,:) -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r1725 r2007 85 85 !!gm here no overwrite, test all option via namelist change: require more incore memory 86 86 !!gm IF( lk_sbc_cpl ) THEN ; ln_cpl = .TRUE. ; ELSE ; ln_cpl = .FALSE. ; ENDIF 87 #if defined key_agrif 87 88 88 IF ( Agrif_Root() ) THEN 89 #endif90 89 IF( lk_lim2 ) nn_ice = 2 91 90 IF( lk_lim3 ) nn_ice = 3 92 #if defined key_agrif 93 ENDIF 94 #endif 91 ENDIF 92 ! 95 93 IF( cp_cfg == 'gyre' ) THEN 96 94 ln_ana = .TRUE. -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90
r1601 r2007 99 99 100 100 # elif defined key_dynspg_flt && defined key_obc 101 102 DO jj = 2, jpjm1 ! matrix of free surface elliptic system with open boundaries103 DO ji = 2, jpim1104 zcoef = z2dt * z2dt * grav * bmask(ji,jj)105 ! ! south coefficient106 IF( lp_obc_south .AND. ( jj == njs0p1 ) ) THEN107 zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)*(1.-vsmsk(ji,1))108 ELSE109 zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)110 END IF111 gcp(ji,jj,1) = zcoefs112 !113 ! ! west coefficient114 IF( lp_obc_west .AND. ( ji == niw0p1 ) ) THEN115 zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)*(1.-uwmsk(jj,1))116 ELSE117 zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)118 END IF119 gcp(ji,jj,2) = zcoefw120 !121 ! ! east coefficient122 IF( lp_obc_east .AND. ( ji == nie0 ) ) THEN123 zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)*(1.-uemsk(jj,1))124 ELSE125 zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)126 END IF127 gcp(ji,jj,3) = zcoefe128 !129 ! ! north coefficient130 IF( lp_obc_north .AND. ( jj == njn0 ) ) THEN131 zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)*(1.-vnmsk(ji,1))132 ELSE101 IF( Agrif_Root() ) THEN 102 DO jj = 2, jpjm1 ! matrix of free surface elliptic system with open boundaries 103 DO ji = 2, jpim1 104 zcoef = z2dt * z2dt * grav * bmask(ji,jj) 105 ! ! south coefficient 106 IF( lp_obc_south .AND. ( jj == njs0p1 ) ) THEN 107 zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)*(1.-vsmsk(ji,1)) 108 ELSE 109 zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1) 110 END IF 111 gcp(ji,jj,1) = zcoefs 112 ! 113 ! ! west coefficient 114 IF( lp_obc_west .AND. ( ji == niw0p1 ) ) THEN 115 zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)*(1.-uwmsk(jj,1)) 116 ELSE 117 zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj) 118 END IF 119 gcp(ji,jj,2) = zcoefw 120 ! 121 ! ! east coefficient 122 IF( lp_obc_east .AND. ( ji == nie0 ) ) THEN 123 zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)*(1.-uemsk(jj,1)) 124 ELSE 125 zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj) 126 END IF 127 gcp(ji,jj,3) = zcoefe 128 ! 129 ! ! north coefficient 130 IF( lp_obc_north .AND. ( jj == njn0 ) ) THEN 131 zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)*(1.-vnmsk(ji,1)) 132 ELSE 133 133 zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj) 134 END IF 135 gcp(ji,jj,4) = zcoefn 136 ! 137 ! ! diagonal coefficient 138 gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj) & 139 & - zcoefs -zcoefw -zcoefe -zcoefn 134 END IF 135 gcp(ji,jj,4) = zcoefn 136 ! 137 ! ! diagonal coefficient 138 gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj) & 139 & - zcoefs -zcoefw -zcoefe -zcoefn 140 END DO 140 141 END DO 141 END DO142 ENDIF 142 143 #endif 143 144 -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r1528 r2007 179 179 END DO 180 180 181 ! "zonal" mean advective heat and salt transport 182 IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 183 pht_adv(:) = ptr_vj( ztv(:,:,:) ) 184 pst_adv(:) = ptr_vj( zsv(:,:,:) ) 185 ENDIF 181 186 182 187 ! Save the intermediate i / j / k advective trends for diagnostics … … 366 371 ! "zonal" mean advective heat and salt transport 367 372 IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 368 pht_adv(:) = ptr_vj( ztv(:,:,:) ) 369 pst_adv(:) = ptr_vj( zsv(:,:,:) ) 373 pht_adv(:) = ptr_vj( ztv(:,:,:) ) + pht_adv(:) 374 pst_adv(:) = ptr_vj( zsv(:,:,:) ) + pst_adv(:) 370 375 ENDIF 371 376 ! -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r1601 r2007 38 38 USE agrif_opa_update 39 39 USE agrif_opa_interp 40 USE obc_oce 40 41 41 42 IMPLICIT NONE … … 101 102 ! 102 103 #if defined key_obc 103 CALL obc_tra( kt )! OBC open boundaries104 IF( lk_obc ) CALL obc_tra( kt ) ! OBC open boundaries 104 105 #endif 105 106 #if defined key_bdy -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r1739 r2007 134 134 zta = ro0cpr * qns(ji,jj) * zse3t & ! temperature : heat flux 135 135 & - emp(ji,jj) * zsrau * tn(ji,jj,1) * zse3t ! & cooling/heating effet of EMP flux 136 zsa = 0.e0 ! No salinity concent./dilut. effect 136 zsa = ( emps(ji,jj) - emp(ji,jj) ) & 137 & * zsrau * sn(ji,jj,1) * zse3t ! concent./dilut. effect due to sea-ice 138 ! melt/formation and (possibly) SSS restoration 137 139 ELSE 138 140 zta = ro0cpr * qns(ji,jj) * zse3t ! temperature : heat flux -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/lib_mpp.F90
r1987 r2007 103 103 !! ========================= !! 104 104 !$AGRIF_DO_NOT_TREAT 105 INCLUDE 'mpif.h'105 INCLUDE mpif.h 106 106 !$AGRIF_END_DO_NOT_TREAT 107 107 … … 112 112 INTEGER :: mppsize ! number of process 113 113 INTEGER :: mpprank ! process number [ 0 - size-1 ] 114 INTEGER :: mpi_comm_opa ! opa local communicator 114 !$AGRIF_DO_NOT_TREAT 115 INTEGER, PUBLIC :: mpi_comm_opa ! opa local communicator 116 !$AGRIF_END_DO_NOT_TREAT 115 117 116 118 ! variables used in case of sea-ice … … 191 193 WRITE(ldtxt(6),*) ' size in bytes of exported buffer nn_buffer = ', nn_buffer 192 194 193 #if defined key_agrif 194 IF( Agrif_Root() ) THEN 195 #endif 196 !!bug RB : should be clean to use Agrif in coupled mode 197 #if ! defined key_agrif 198 CALL mpi_initialized ( mpi_was_called, code ) 199 IF( code /= MPI_SUCCESS ) THEN 200 WRITE(*, cform_err) 201 WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 202 CALL mpi_abort( mpi_comm_world, code, ierr ) 203 ENDIF 204 205 IF( PRESENT(localComm) .and. mpi_was_called ) THEN 206 mpi_comm_opa = localComm 207 SELECT CASE ( cn_mpi_send ) 208 CASE ( 'S' ) ! Standard mpi send (blocking) 209 WRITE(ldtxt(7),*) ' Standard blocking mpi send (send)' 210 CASE ( 'B' ) ! Buffer mpi send (blocking) 211 WRITE(ldtxt(7),*) ' Buffer blocking mpi send (bsend)' 212 CALL mpi_init_opa( ierr ) 213 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 214 WRITE(ldtxt(7),*) ' Immediate non-blocking send (isend)' 215 l_isend = .TRUE. 216 CASE DEFAULT 217 WRITE(ldtxt(7),cform_err) 218 WRITE(ldtxt(8),*) ' bad value for cn_mpi_send = ', cn_mpi_send 219 nstop = nstop + 1 220 END SELECT 221 ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 222 WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 223 WRITE(ldtxt(8),*) ' without calling MPI_Init before ! ' 224 nstop = nstop + 1 225 ELSE 226 #endif 227 SELECT CASE ( cn_mpi_send ) 228 CASE ( 'S' ) ! Standard mpi send (blocking) 229 WRITE(ldtxt(7),*) ' Standard blocking mpi send (send)' 230 CALL mpi_init( ierr ) 231 CASE ( 'B' ) ! Buffer mpi send (blocking) 232 WRITE(ldtxt(7),*) ' Buffer blocking mpi send (bsend)' 233 CALL mpi_init_opa( ierr ) 234 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 235 WRITE(ldtxt(7),*) ' Immediate non-blocking send (isend)' 236 l_isend = .TRUE. 237 CALL mpi_init( ierr ) 238 CASE DEFAULT 239 WRITE(ldtxt(7),cform_err) 240 WRITE(ldtxt(8),*) ' bad value for cn_mpi_send = ', cn_mpi_send 241 nstop = nstop + 1 242 END SELECT 243 244 #if ! defined key_agrif 245 CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 246 IF( code /= MPI_SUCCESS ) THEN 247 WRITE(*, cform_err) 248 WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 249 CALL mpi_abort( mpi_comm_world, code, ierr ) 250 ENDIF 251 ! 252 ENDIF 253 #endif 254 #if defined key_agrif 255 ELSE 195 CALL mpi_initialized ( mpi_was_called, code ) 196 IF( code /= MPI_SUCCESS ) THEN 197 WRITE(*, cform_err) 198 WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 199 CALL mpi_abort( mpi_comm_world, code, ierr ) 200 ENDIF 201 202 IF( mpi_was_called ) THEN 203 ! 256 204 SELECT CASE ( cn_mpi_send ) 257 205 CASE ( 'S' ) ! Standard mpi send (blocking) … … 259 207 CASE ( 'B' ) ! Buffer mpi send (blocking) 260 208 WRITE(ldtxt(7),*) ' Buffer blocking mpi send (bsend)' 209 CALL mpi_init_opa( ierr ) 261 210 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 262 211 WRITE(ldtxt(7),*) ' Immediate non-blocking send (isend)' … … 267 216 nstop = nstop + 1 268 217 END SELECT 218 ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 219 WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 220 WRITE(ldtxt(8),*) ' without calling MPI_Init before ! ' 221 nstop = nstop + 1 222 ELSE 223 SELECT CASE ( cn_mpi_send ) 224 CASE ( 'S' ) ! Standard mpi send (blocking) 225 WRITE(ldtxt(7),*) ' Standard blocking mpi send (send)' 226 CALL mpi_init( ierr ) 227 CASE ( 'B' ) ! Buffer mpi send (blocking) 228 WRITE(ldtxt(7),*) ' Buffer blocking mpi send (bsend)' 229 CALL mpi_init_opa( ierr ) 230 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 231 WRITE(ldtxt(7),*) ' Immediate non-blocking send (isend)' 232 l_isend = .TRUE. 233 CALL mpi_init( ierr ) 234 CASE DEFAULT 235 WRITE(ldtxt(7),cform_err) 236 WRITE(ldtxt(8),*) ' bad value for cn_mpi_send = ', cn_mpi_send 237 nstop = nstop + 1 238 END SELECT 239 ! 269 240 ENDIF 270 241 271 mpi_comm_opa = mpi_comm_world 272 #endif 242 IF( PRESENT(localComm) ) THEN 243 IF( Agrif_Root() ) THEN 244 mpi_comm_opa = localComm 245 ENDIF 246 ELSE 247 CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 248 IF( code /= MPI_SUCCESS ) THEN 249 WRITE(*, cform_err) 250 WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 251 CALL mpi_abort( mpi_comm_world, code, ierr ) 252 ENDIF 253 ENDIF 254 273 255 CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr ) 274 256 CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr ) … … 2067 2049 ijpj = 4 2068 2050 ijpjm1 = 3 2051 ztab(:,:,:) = 0.e0 2069 2052 ! 2070 2053 DO jj = nlcj - ijpj +1, nlcj ! put in znorthloc the last 4 jlines of pt3d … … 2132 2115 ijpj = 4 2133 2116 ijpjm1 = 3 2117 ztab(:,:) = 0.e0 2134 2118 ! 2135 2119 DO jj = nlcj-ijpj+1, nlcj ! put in znorthloc the last 4 jlines of pt2d … … 2197 2181 ! 2198 2182 ijpj=4 2183 ztab(:,:) = 0.e0 2199 2184 2200 2185 ij=0 -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/opa.F90
r1725 r2007 156 156 CALL opa_closefile 157 157 #if defined key_oasis3 || defined key_oasis4 158 CALL cpl_prism_finalize ! end coupling and mpp communications with OASIS 158 IF( Agrif_Root() ) THEN 159 CALL cpl_prism_finalize ! end coupling and mpp communications with OASIS 160 ENDIF 159 161 #else 160 162 IF( lk_mpp ) CALL mppstop ! end mpp communications … … 191 193 #if defined key_iomput 192 194 # if defined key_oasis3 || defined key_oasis4 193 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 194 CALL init_ioclient() ! io_server will get its communicators (if needed) from oasis (we don't see it) 195 IF( Agrif_Root() ) THEN 196 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 197 CALL init_ioclient() ! io_server will get its communicators (if needed) from oasis (we don't see it) 198 ENDIF 195 199 # else 196 CALL init_ioclient( ilocal_comm ) ! nemo local communicator (used or not) given by the io_server 200 IF( Agrif_Root() ) THEN 201 CALL init_ioclient( ilocal_comm ) ! nemo local communicator (used or not) given by the io_server 202 ENDIF 197 203 # endif 198 204 narea = mynode( cltxt, ilocal_comm ) ! Nodes selection … … 200 206 #else 201 207 # if defined key_oasis3 || defined key_oasis4 202 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 208 IF( Agrif_Root() ) THEN 209 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 210 ENDIF 203 211 narea = mynode( cltxt, ilocal_comm ) ! Nodes selection (control print return in cltxt) 204 212 # else -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/par_POMME_R025.h90
r1648 r2007 22 22 jp_cfg = 025 , & !: resolution of the configuration (degrees) 23 23 ! Original data size 24 25 24 ! ORCA025 global grid size 26 25 jpiglo_ORCA025 = 1442, & 27 26 jpjglo_ORCA025 = 1021, & ! not used currently 28 29 27 ! POMME "global" domain localisation in the ORCA025 global grid 30 28 jpi_iw = 1059, & … … 32 30 jpj_js = 661, & 33 31 jpj_jn = 700, & 34 35 32 jpidta = ( jpi_ie - jpi_iw + 1 ), & !: =30 first horizontal dimension > or = to jpi 36 33 jpjdta = ( jpj_jn - jpj_js + 1 ), & !: =40 second > or = to jpj 37 34 jpkdta = 46 , & !: number of levels > or = to jpk 38 39 35 ! total domain matrix size 40 36 jpiglo = jpidta, & !: first dimension of global domain --> i -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/step.F90
r1756 r2007 166 166 #if defined key_agrif 167 167 kstp = nit000 + Agrif_Nb_Step() 168 ! IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 169 ! IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 168 ! IF( Agrif_Root() .and. lwp) Write(*,*) '---' 169 ! IF(lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 170 # if defined key_iomput 171 IF( Agrif_Nbstepint() == 0) CALL iom_swap 172 # endif 170 173 #endif 171 174 indic = 1 ! reset to no error condition -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
r1581 r2007 126 126 zrgb(1,51) = 3.162 ; zrgb(2,51) = 0.22703 ; zrgb(3,51) = 0.16599 ; zrgb(4,51) = 0.46601 127 127 zrgb(1,52) = 3.548 ; zrgb(2,52) = 0.24433 ; zrgb(3,52) = 0.17334 ; zrgb(4,52) = 0.47313 128 zrgb(1,53) = 3.981 ; zrgb(2,53) = 0.26301 ; zrgb(3,53) = 0.18126 ; zrgb(4,5 4) = 0.48080129 zrgb(1,54) = 4.467 ; zrgb(2,54) = 0.28320 ; zrgb(3,54) = 0.18981 ; zrgb(4,5 5) = 0.48909130 zrgb(1,55) = 5.012 ; zrgb(2,55) = 0.30502 ; zrgb(3,55) = 0.19903 ; zrgb(4,5 6) = 0.49803131 zrgb(1,56) = 5.623 ; zrgb(2,56) = 0.32858 ; zrgb(3,56) = 0.20898 ; zrgb(4,5 7) = 0.50768132 zrgb(1,57) = 6.310 ; zrgb(2,57) = 0.35404 ; zrgb(3,57) = 0.21971 ; zrgb(4,5 8) = 0.51810133 zrgb(1,58) = 7.079 ; zrgb(2,58) = 0.38154 ; zrgb(3,58) = 0.23129 ; zrgb(4,5 9) = 0.52934134 zrgb(1,59) = 7.943 ; zrgb(2,59) = 0.41125 ; zrgb(3,59) = 0.24378 ; zrgb(4,5 0) = 0.54147128 zrgb(1,53) = 3.981 ; zrgb(2,53) = 0.26301 ; zrgb(3,53) = 0.18126 ; zrgb(4,53) = 0.48080 129 zrgb(1,54) = 4.467 ; zrgb(2,54) = 0.28320 ; zrgb(3,54) = 0.18981 ; zrgb(4,54) = 0.48909 130 zrgb(1,55) = 5.012 ; zrgb(2,55) = 0.30502 ; zrgb(3,55) = 0.19903 ; zrgb(4,55) = 0.49803 131 zrgb(1,56) = 5.623 ; zrgb(2,56) = 0.32858 ; zrgb(3,56) = 0.20898 ; zrgb(4,56) = 0.50768 132 zrgb(1,57) = 6.310 ; zrgb(2,57) = 0.35404 ; zrgb(3,57) = 0.21971 ; zrgb(4,57) = 0.51810 133 zrgb(1,58) = 7.079 ; zrgb(2,58) = 0.38154 ; zrgb(3,58) = 0.23129 ; zrgb(4,58) = 0.52934 134 zrgb(1,59) = 7.943 ; zrgb(2,59) = 0.41125 ; zrgb(3,59) = 0.24378 ; zrgb(4,59) = 0.54147 135 135 zrgb(1,60) = 8.912 ; zrgb(2,60) = 0.44336 ; zrgb(3,60) = 0.25725 ; zrgb(4,60) = 0.55457 136 136 zrgb(1,61) = 10.000 ; zrgb(2,61) = 0.47804 ; zrgb(3,61) = 0.27178 ; zrgb(4,61) = 0.56870 -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/C14b/trclsm_c14b.F90
r1581 r2007 44 44 INTEGER :: numnatb 45 45 46 #if defined key_trc_diaadd 46 #if defined key_trc_diaadd && ! defined key_iomput 47 47 ! definition of additional diagnostic as a structure 48 48 INTEGER :: jl, jn … … 58 58 !! 59 59 NAMELIST/namc14date/ ndate_beg_b, nyear_res_b 60 #if defined key_trc_diaadd 60 #if defined key_trc_diaadd && ! defined key_iomput 61 61 NAMELIST/namc14dia/nwritedia, c14dia2d, c14dia3d ! additional diagnostics 62 62 #endif … … 81 81 IF(lwp) WRITE(numout,*) ' initial year (aa) nyear_beg_b = ', nyear_beg_b 82 82 ! 83 #if defined key_trc_diaadd 83 #if defined key_trc_diaadd && ! defined key_iomput 84 84 85 85 ! Namelist namc14dia -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/CFC/trcctl_cfc.F90
r1255 r2007 44 44 IF( jp_cfc > 2) THEN 45 45 IF(lwp) THEN 46 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 47 WRITE (numout,*) ' ======= ============= ' 46 WRITE (numout,*) ' ===>>>> : w a r n i n g <<<<===' 48 47 WRITE (numout,*) & 49 48 & ' STOP, change jp_cfc to 1 or 2 in par_CFC module ' … … 62 61 63 62 IF(lwp) THEN 64 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 65 WRITE (numout,*) ' ======= ============= ' 63 WRITE (numout,*) ' ===>>>> : w a r n i n g <<<<===' 66 64 WRITE (numout,*) ' we force tracer names' 67 65 DO jl = 1, jp_cfc … … 80 78 ctrcun(jn) = 'mole/m3' 81 79 IF(lwp) THEN 82 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 83 WRITE (numout,*) ' ======= ============= ' 80 WRITE (numout,*) ' ===>>>> : w a r n i n g <<<<===' 84 81 WRITE (numout,*) ' we force tracer unit' 85 82 WRITE(numout,*) ' tracer ',ctrcnm(jn), 'UNIT= ',ctrcun(jn) -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/CFC/trclsm_cfc.F90
r1581 r2007 43 43 !!---------------------------------------------------------------------- 44 44 INTEGER :: numnatc 45 #if defined key_trc_diaadd 45 #if defined key_trc_diaadd && ! defined key_iomput 46 46 ! definition of additional diagnostic as a structure 47 47 INTEGER :: jl, jn … … 56 56 !! 57 57 NAMELIST/namcfcdate/ ndate_beg, nyear_res 58 #if defined key_trc_diaadd 58 #if defined key_trc_diaadd && ! defined key_iomput 59 59 NAMELIST/namcfcdia/nwritedia, cfcdia2d ! additional diagnostics 60 60 #endif … … 79 79 IF(lwp) WRITE(numout,*) ' initial year (aa) nyear_beg = ', nyear_beg 80 80 ! 81 #if defined key_trc_diaadd 81 #if defined key_trc_diaadd && ! defined key_iomput 82 82 83 83 ! Namelist namcfcdia -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90
r1457 r2007 482 482 ENDIF 483 483 484 IF( l_trdtrc ) DEALLOCATE( ztrbio ) 485 484 486 IF(ln_ctl) THEN ! print mean trends (used for debugging) 485 487 WRITE(charout, FMT="('bio')") -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90
r1457 r2007 164 164 ENDIF 165 165 166 IF( l_trdtrc ) DEALLOCATE( ztrbio ) 167 166 168 IF(ln_ctl) THEN ! print mean trends (used for debugging) 167 169 WRITE(charout, FMT="('exp')") -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90
r1542 r2007 26 26 PUBLIC trc_ini_lobster ! called by trcini.F90 module 27 27 28 # include "domzgr_substitute.h90"29 28 # include "top_substitute.h90" 30 29 !!---------------------------------------------------------------------- -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcopt.F90
r1445 r2007 28 28 29 29 !!* Substitution 30 # include " domzgr_substitute.h90"30 # include "top_substitute.h90" 31 31 !!---------------------------------------------------------------------- 32 32 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90
r1457 r2007 29 29 30 30 !!* Substitution 31 # include " domzgr_substitute.h90"31 # include "top_substitute.h90" 32 32 !!---------------------------------------------------------------------- 33 33 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) … … 136 136 ENDIF 137 137 138 IF( l_trdtrc ) DEALLOCATE( ztrbio ) 139 138 140 IF(ln_ctl) THEN ! print mean trends (used for debugging) 139 141 WRITE(charout, FMT="('sed')") -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zbio.F90
r1678 r2007 39 39 40 40 !!* Substitution 41 # include " domzgr_substitute.h90"41 # include "top_substitute.h90" 42 42 !!---------------------------------------------------------------------- 43 43 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90
r1180 r2007 147 147 148 148 !!* Substitution 149 #include " domzgr_substitute.h90"149 #include "top_substitute.h90" 150 150 !!---------------------------------------------------------------------- 151 151 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90
r1737 r2007 52 52 53 53 !!* Substitution 54 # include " domzgr_substitute.h90"54 # include "top_substitute.h90" 55 55 !!---------------------------------------------------------------------- 56 56 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) … … 204 204 CALL mpp_sum( t_oce_co2_flx ) ! sum over the global domain 205 205 ENDIF 206 ! Conversion in GtC/yr ; negative for outgoing from ocean 207 t_oce_co2_flx = (-1.) * t_oce_co2_flx * 12. / 1.e15 208 ! 206 209 WRITE(numout,*) ' Atmospheric pCO2 :' 207 210 WRITE(numout,*) '-------------------- : ',kt,' ',t_atm_co2_flx 208 211 WRITE(numout,*) '(ppm)' 209 WRITE(numout,*) 'Total Flux of Carbon :'210 WRITE(numout,*) '-------------------- : ',t_oce_co2_flx * 12. / 1e15211 WRITE(numout,*) '(GtC/ an)'212 WRITE(numout,*) 'Total Flux of Carbon out of the ocean :' 213 WRITE(numout,*) '-------------------- : ',t_oce_co2_flx 214 WRITE(numout,*) '(GtC/yr)' 212 215 t_atm_co2_flx = 0. 213 216 t_oce_co2_flx = 0. 217 # if defined key_iomput 218 CALL iom_put( "tatpco2" , t_atm_co2_flx ) 219 CALL iom_put( "tco2flx" , t_oce_co2_flx ) 220 #endif 214 221 ENDIF 215 222 #endif -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlim.F90
r1152 r2007 41 41 42 42 !!* Substitution 43 # include " domzgr_substitute.h90"43 # include "top_substitute.h90" 44 44 !!---------------------------------------------------------------------- 45 45 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90
r1735 r2007 67 67 #if defined key_trc_dia3d && defined key_iomput 68 68 REAL(wp) :: zrfact2 69 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zcaldiss , zw3d69 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zcaldiss 70 70 #endif 71 71 CHARACTER (len=25) :: charout … … 94 94 ! SET DUMMY VARIABLE FOR TOTAL BORATE 95 95 zbot = borat(ji,jj,jk) 96 97 ! SET DUMMY VARIABLE FOR TOTAL BORATE 98 zbot = borat(ji,jj,jk) 96 99 zfact = rhop (ji,jj,jk) / 1000. + rtrn 97 100 … … 171 174 # else 172 175 zrfact2 = 1.e3 * rfact2r 173 zw3d(:,:,:) = hi (:,:,:) * tmask(:,:,:) 174 CALL iom_put( "PH", zw3d ) 175 zw3d(:,:,:) = zco3(:,:,:) * tmask(:,:,:) 176 CALL iom_put( "CO3", zw3d ) 177 zw3d(:,:,:) = aksp(:,:,:) / calcon * tmask(:,:,:) 178 CALL iom_put( "CO3sat", zw3d ) 179 zw3d(:,:,:) = zcaldiss(:,:,:) * zrfact2 * tmask(:,:,:) 180 CALL iom_put( "Dcal", zw3d ) 176 CALL iom_put( "PH" , hi (:,:,:) * tmask(:,:,:) ) 177 CALL iom_put( "CO3" , zco3 (:,:,:) * tmask(:,:,:) ) 178 CALL iom_put( "CO3sat", aksp (:,:,:) / calcon * tmask(:,:,:) ) 179 CALL iom_put( "DCAL" , zcaldiss(:,:,:) * zrfact2 * tmask(:,:,:) ) 181 180 # endif 182 181 # endif … … 232 231 END SUBROUTINE p4z_lys 233 232 #endif 234 235 233 !!====================================================================== 236 234 END MODULE p4zlys -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmeso.F90
r1736 r2007 45 45 46 46 !!* Substitution 47 # include " domzgr_substitute.h90"47 # include "top_substitute.h90" 48 48 !!---------------------------------------------------------------------- 49 49 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) … … 76 76 #if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 77 77 REAL(wp) :: zrfact2 78 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d79 78 #endif 80 79 … … 203 202 END DO 204 203 204 #if defined key_trc_dia3d 205 ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 206 grazing(:,:,:) = grazing(:,:,:) + ( zgrazd (:,:,:) + zgrazz (:,:,:) + zgrazn(:,:,:) & 207 & + zgrazpoc(:,:,:) + zgrazffe(:,:,:) ) 208 #endif 209 205 210 206 211 DO jk = 1,jpkm1 … … 311 316 #if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 312 317 zrfact2 = 1.e3 * rfact2r 313 zw3d(:,:,:) = ( zgrazd(:,:,:) + zgrazz(:,:,:) + zgrazn(:,:,:) & 314 & + zgrazpoc(:,:,:) + zgrazffe(:,:,:) ) * zrfact2 * tmask(:,:,:) 315 IF( jnt == nrdttrc ) CALL iom_put( "Graz2" , zw3d ) 316 317 zw3d(:,:,:) = prodcal(:,:,:) * zrfact2 * tmask(:,:,:) 318 IF( jnt == nrdttrc ) CALL iom_put( "Pcal" , zw3d ) 318 ! Total grazing of phyto by zoo 319 grazing(:,:,:) = grazing(:,:,:) * zrfact2 * tmask(:,:,:) 320 ! Calcite production 321 prodcal(:,:,:) = prodcal(:,:,:) * zrfact2 * tmask(:,:,:) 322 IF( jnt == nrdttrc ) then 323 CALL iom_put( "GRAZ" , grazing ) ! Total grazing of phyto by zooplankton 324 CALL iom_put( "PCAL" , prodcal ) ! Calcite production 325 ENDIF 319 326 #endif 320 327 -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmicro.F90
r1736 r2007 43 43 44 44 !!* Substitution 45 # include " domzgr_substitute.h90"45 # include "top_substitute.h90" 46 46 !!---------------------------------------------------------------------- 47 47 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) … … 70 70 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazmf, zgrazsf, zgrazpf 71 71 CHARACTER (len=25) :: charout 72 #if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput73 REAL(wp) :: zrfact274 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d75 #endif76 72 77 73 !!--------------------------------------------------------------------- … … 88 84 zgrazpf(:,:,:) = 0. 89 85 86 #if defined key_trc_dia3d 87 grazing(:,:,:) = 0. !: Initialisation of grazing 88 #endif 90 89 91 90 zstep = rfact2 / rday ! Time step duration for biology … … 156 155 END DO 157 156 157 #if defined key_trc_dia3d 158 ! Grazing by microzooplankton 159 grazing(:,:,:) = grazing(:,:,:) + zgrazp(:,:,:) + zgrazm(:,:,:) + zgrazsd(:,:,:) 160 #endif 158 161 159 162 DO jk = 1,jpkm1 … … 231 234 END DO 232 235 ! 233 #if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 234 zrfact2 = 1.e3 * rfact2r 235 zw3d(:,:,:) = ( zgrazp(:,:,:) + zgrazm(:,:,:) + zgrazsd(:,:,:) ) * zrfact2 * tmask(:,:,:) 236 IF( jnt == nrdttrc ) CALL iom_put( "Graz" , zw3d ) 237 #endif 238 239 IF(ln_ctl) THEN ! print mean trends (used for debugging) 236 IF(ln_ctl) THEN ! print mean trends (used for debugging) 240 237 WRITE(charout, FMT="('micro')") 241 238 CALL prt_ctl_trc_info(charout) 242 239 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 243 240 ENDIF 244 241 245 242 END SUBROUTINE p4z_micro -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmort.F90
r1736 r2007 41 41 42 42 !!* Substitution 43 # include " domzgr_substitute.h90"43 # include "top_substitute.h90" 44 44 !!---------------------------------------------------------------------- 45 45 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90
r1678 r2007 35 35 36 36 !!* Substitution 37 # include " domzgr_substitute.h90"37 # include "top_substitute.h90" 38 38 !!---------------------------------------------------------------------- 39 39 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) … … 61 61 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zekg, zekr, zekb 62 62 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze1 , ze2 , ze3, ze0 63 #if defined key_trc_diaadd && defined key_iomput64 REAL(wp), DIMENSION(jpi,jpj) :: zw2d65 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d66 #endif67 63 !!--------------------------------------------------------------------- 68 64 … … 238 234 # else 239 235 ! write diagnostics 240 zw2d(:,: ) = heup(:,: ) * tmask(:,:,1)241 zw3d(:,:,:) = etot(:,:,:) * tmask(:,:,:)242 IF( jnt == nrdttrc ) CALL iom_put( "Heup", zw2d )243 IF( jnt == nrdttrc ) CALL iom_put( "PAR" , zw3d )236 IF( jnt == nrdttrc ) then 237 CALL iom_put( "Heup", heup(:,: ) * tmask(:,:,1) ) ! euphotic layer deptht 238 CALL iom_put( "PAR" , etot(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation 239 ENDIF 244 240 # endif 245 241 #endif -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90
r1736 r2007 53 53 54 54 !!* Substitution 55 # include " domzgr_substitute.h90"55 # include "top_substitute.h90" 56 56 !!---------------------------------------------------------------------- 57 57 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) … … 81 81 #if defined key_trc_diaadd && defined key_trc_dia3d 82 82 REAL(wp) :: zrfact2 83 #if defined key_iomput84 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d85 #endif86 83 #endif 87 84 REAL(wp), DIMENSION(jpi,jpj) :: zmixnano , zmixdiat, zstrn … … 352 349 WRITE(numout,*) 'Total PP :' 353 350 WRITE(numout,*) '-------------------- : ',tpp * 12. / 1.E12 354 WRITE(numout,*) '(GtC/ an)'351 WRITE(numout,*) '(GtC/yr)' 355 352 tpp = 0. 356 353 ENDIF 357 354 358 #if defined key_trc_diaadd && defined key_trc_dia3d 355 #if defined key_trc_diaadd && defined key_trc_dia3d && ! defined key_iomput 356 ! Supplementary diagnostics 359 357 zrfact2 = 1.e3 * rfact2r 360 ! Supplementary diagnostics361 # if ! defined key_iomput362 358 trc3d(:,:,:,jp_pcs0_3d + 4) = zprorca (:,:,:) * zrfact2 * tmask(:,:,:) 363 359 trc3d(:,:,:,jp_pcs0_3d + 5) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) … … 366 362 trc3d(:,:,:,jp_pcs0_3d + 8) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) 367 363 trc3d(:,:,:,jp_pcs0_3d + 9) = zprofed (:,:,:) * zrfact2 * tmask(:,:,:) 368 # if ! defined key_kriest364 # if ! defined key_kriest 369 365 trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:) 366 # endif 370 367 #endif 371 368 372 # else 373 zw3d(:,:,:) = zprorca (:,:,:) * zrfact2 * tmask(:,:,:) 374 IF( jnt == nrdttrc ) CALL iom_put( "PPPHY" , zw3d ) 375 zw3d(:,:,:) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) 376 IF( jnt == nrdttrc ) CALL iom_put( "PPPHY2", zw3d ) 377 zw3d(:,:,:) = zpronew (:,:,:) * zrfact2 * tmask(:,:,:) 378 IF( jnt == nrdttrc ) CALL iom_put( "PPNEWN" , zw3d ) 379 zw3d(:,:,:) = zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) 380 IF( jnt == nrdttrc ) CALL iom_put( "PPNEWD", zw3d ) 381 zw3d(:,:,:) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) 382 IF( jnt == nrdttrc ) CALL iom_put( "PBSi" , zw3d ) 383 zw3d(:,:,:) = zprofed (:,:,:) * zrfact2 * tmask(:,:,:) 384 IF( jnt == nrdttrc ) CALL iom_put( "PFeD" , zw3d ) 385 zw3d(:,:,:) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:) 386 IF( jnt == nrdttrc ) CALL iom_put( "PFeN" , zw3d ) 387 # endif 369 #if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 370 zrfact2 = 1.e3 * rfact2r 371 IF ( jnt == nrdttrc ) then 372 CALL iom_put( "PPPHY" , zprorca (:,:,:) * zrfact2 * tmask(:,:,:) ) ! primary production by nanophyto 373 CALL iom_put( "PPPHY2", zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) ) ! primary production by diatom 374 CALL iom_put( "PPNEWN", zpronew (:,:,:) * zrfact2 * tmask(:,:,:) ) ! new primary production by nanophyto 375 CALL iom_put( "PPNEWD", zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) ) ! new primary production by diatom 376 CALL iom_put( "PBSi" , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production 377 CALL iom_put( "PFeD" , zprofed (:,:,:) * zrfact2 * tmask(:,:,:) ) ! biogenic iron production by diatom 378 CALL iom_put( "PFeN" , zprofen (:,:,:) * zrfact2 * tmask(:,:,:) ) ! biogenic iron production by nanophyto 379 ENDIF 388 380 #endif 389 381 -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90
r1744 r2007 45 45 46 46 !!* Substitution 47 # include " domzgr_substitute.h90"47 # include "top_substitute.h90" 48 48 !!---------------------------------------------------------------------- 49 49 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90
r1735 r2007 96 96 REAL(wp) :: zrfact2 97 97 # if defined key_iomput 98 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d99 98 REAL(wp), DIMENSION(jpi,jpj) :: zw2d 100 99 # endif … … 332 331 trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * 1.e-7 * zrfact2 * fse3t(:,:,1) * tmask(:,:,1) 333 332 # else 334 ! write diagnostics 335 zw2d(:,:) = ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) & 336 & * zrfact2 * fse3t(:,:,1) * tmask(:,:,1) 333 ! surface downward net flux of iron 334 zw2d(:,:) = ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zrfact2 * fse3t(:,:,1) * tmask(:,:,1) 337 335 IF( jnt == nrdttrc ) CALL iom_put( "Irondep", zw2d ) 338 zw3d(:,:,:) = znitrpot(:,:,:) * 1.e-7 * zrfact2 * fse3t(:,:,:) * tmask(:,:,:)339 IF( jnt == nrdttrc ) CALL iom_put( "Nfix", zw3d )340 # endif 341 336 ! nitrogen fixation at surface 337 zw2d(:,:) = znitrpot(:,:,1) * 1.e-7 * zrfact2 * fse3t(:,:,1) * tmask(:,:,1) 338 IF( jnt == nrdttrc ) CALL iom_put( "Nfix" , zw2d ) 339 # endif 342 340 # endif 343 341 ! -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90
r1736 r2007 69 69 70 70 !!* Substitution 71 # include " domzgr_substitute.h90"71 # include "top_substitute.h90" 72 72 !!---------------------------------------------------------------------- 73 73 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) … … 99 99 #if defined key_trc_diaadd 100 100 REAL(wp) :: zrfact2 101 INTEGER :: iksed1 102 #if defined key_iomput 103 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d 104 #endif 101 INTEGER :: ik1 105 102 #endif 106 103 REAL(wp), DIMENSION(jpi,jpj,jpk) :: znum3d … … 286 283 #if defined key_trc_diaadd 287 284 zrfact2 = 1.e3 * rfact2r 288 ik sed1 = iksed + 1285 ik1 = iksed + 1 289 286 # if ! defined key_iomput 290 trc2d(:,: ,jp_pcs0_2d + 4) = sinking (:,:,ik sed1) * zrfact2 * tmask(:,:,1)291 trc2d(:,: ,jp_pcs0_2d + 5) = sinking2(:,:,ik sed1) * zrfact2 * tmask(:,:,1)292 trc2d(:,: ,jp_pcs0_2d + 6) = sinkfer (:,:,ik sed1) * zrfact2 * tmask(:,:,1)293 trc2d(:,: ,jp_pcs0_2d + 7) = sinksil (:,:,ik sed1) * zrfact2 * tmask(:,:,1)294 trc2d(:,: ,jp_pcs0_2d + 8) = sinkcal (:,:,ik sed1) * zrfact2 * tmask(:,:,1)287 trc2d(:,: ,jp_pcs0_2d + 4) = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) 288 trc2d(:,: ,jp_pcs0_2d + 5) = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) 289 trc2d(:,: ,jp_pcs0_2d + 6) = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) 290 trc2d(:,: ,jp_pcs0_2d + 7) = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) 291 trc2d(:,: ,jp_pcs0_2d + 8) = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) 295 292 trc3d(:,:,:,jp_pcs0_3d + 11) = sinking (:,:,:) * zrfact2 * tmask(:,:,:) 296 293 trc3d(:,:,:,jp_pcs0_3d + 12) = sinking2(:,:,:) * zrfact2 * tmask(:,:,:) … … 301 298 trc3d(:,:,:,jp_pcs0_3d + 17) = wsbio4 (:,:,:) * tmask(:,:,:) 302 299 #else 303 zw3d(:,:,:) = sinking (:,:,:) * zrfact2 * tmask(:,:,:) 304 IF( jnt == nrdttrc ) CALL iom_put( "PMO" , zw3d ) 305 zw3d(:,:,:) = sinking2(:,:,:) * zrfact2 * tmask(:,:,:) 306 IF( jnt == nrdttrc ) CALL iom_put( "PMO2", zw3d ) 307 zw3d(:,:,:) = sinkfer (:,:,:) * zrfact2 * tmask(:,:,:) 308 IF( jnt == nrdttrc ) CALL iom_put( "ExpFe1", zw3d ) 309 zw3d(:,:,:) = sinksil (:,:,:) * zrfact2 * tmask(:,:,:) 310 IF( jnt == nrdttrc ) CALL iom_put( "ExpSi", zw3d ) 311 zw3d(:,:,:) = sinkcal (:,:,:) * zrfact2 * tmask(:,:,:) 312 IF( jnt == nrdttrc ) CALL iom_put( "ExpCaCO3", zw3d ) 313 zw3d(:,:,:) = sinking (:,:,:) * zrfact2 * tmask(:,:,:) 314 IF( jnt == nrdttrc ) CALL iom_put( "POCFlx", zw3d ) 315 zw3d(:,:,:) = sinking2(:,:,:) * zrfact2 * tmask(:,:,:) 316 IF( jnt == nrdttrc ) CALL iom_put( "GOCFlx", zw3d ) 317 zw3d(:,:,:) = sinksil (:,:,:) * zrfact2 * tmask(:,:,:) 318 IF( jnt == nrdttrc ) CALL iom_put( "SiFlx", zw3d ) 319 zw3d(:,:,:) = sinkcal (:,:,:) * zrfact2 * tmask(:,:,:) 320 IF( jnt == nrdttrc ) CALL iom_put( "CaCO3Flx", zw3d ) 321 zw3d(:,:,:) = znum3d (:,:,:) * tmask(:,:,:) 322 IF( jnt == nrdttrc ) CALL iom_put( "xnum", zw3d ) 323 zw3d(:,:,:) = wsbio3 (:,:,:) * tmask(:,:,:) 324 IF( jnt == nrdttrc ) CALL iom_put( "W1", zw3d ) 325 zw3d(:,:,:) = wsbio4 (:,:,:) * tmask(:,:,:) 326 IF( jnt == nrdttrc ) CALL iom_put( "W2", zw3d ) 300 IF( jnt == nrdttrc ) then 301 CALL iom_put( "POCFlx" , sinking (:,:,:) * zrfact2 * tmask(:,:,:) ) ! POC export 302 CALL iom_put( "NumFlx" , sinking2 (:,:,:) * zrfact2 * tmask(:,:,:) ) ! Num export 303 CALL iom_put( "SiFlx" , sinksil (:,:,:) * zrfact2 * tmask(:,:,:) ) ! Silica export 304 CALL iom_put( "CaCO3Flx", sinkcal (:,:,:) * zrfact2 * tmask(:,:,:) ) ! Calcite export 305 CALL iom_put( "xnum" , znum3d (:,:,:) * tmask(:,:,:) ) ! Number of particles in aggregats 306 CALL iom_put( "W1" , wsbio3 (:,:,:) * tmask(:,:,:) ) ! sinking speed of POC 307 CALL iom_put( "W2" , wsbio4 (:,:,:) * tmask(:,:,:) ) ! sinking speed of aggregats 308 CALL iom_put( "PMO" , sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! POC export at 100m 309 CALL iom_put( "PMO2" , sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! Num export at 100m 310 CALL iom_put( "ExpFe1" , sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! Export of iron at 100m 311 CALL iom_put( "ExpSi" , sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! export of silica at 100m 312 CALL iom_put( "ExpCaCO3", sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! export of calcite at 100m 313 ENDIF 327 314 # endif 328 315 … … 489 476 #if defined key_trc_dia3d 490 477 REAL(wp) :: zrfact2 491 INTEGER :: iksed1 492 #endif 493 #if defined key_iomput 494 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d 478 INTEGER :: ik1 495 479 #endif 496 480 CHARACTER (len=25) :: charout … … 613 597 #if defined key_trc_diaadd 614 598 zrfact2 = 1.e3 * rfact2r 615 ik sed1= iksed + 1599 ik1 = iksed + 1 616 600 # if ! defined key_iomput 617 trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,ik sed1) * zrfact2 * tmask(:,:,1)618 trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,ik sed1) * zrfact2 * tmask(:,:,1)619 trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,ik sed1) * zrfact2 * tmask(:,:,1)620 trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,ik sed1) * zrfact2 * tmask(:,:,1)621 trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,ik sed1) * zrfact2 * tmask(:,:,1)622 trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,ik sed1) * zrfact2 * tmask(:,:,1)601 trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) 602 trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) 603 trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) 604 trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,ik1) * zrfact2 * tmask(:,:,1) 605 trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) 606 trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) 623 607 # else 624 zw3d(:,:,:) = sinking (:,:,:) * zrfact2 * tmask(:,:,:) 625 IF( jnt == nrdttrc ) CALL iom_put( "ExpPOC" , zw3d ) 626 zw3d(:,:,:) = sinking2(:,:,:) * zrfact2 * tmask(:,:,:) 627 IF( jnt == nrdttrc ) CALL iom_put( "ExpGOC", zw3d ) 628 zw3d(:,:,:) = sinkfer (:,:,:) * zrfact2 * tmask(:,:,:) 629 IF( jnt == nrdttrc ) CALL iom_put( "ExpFe1", zw3d ) 630 zw3d(:,:,:) = sinkfer2(:,:,:) * zrfact2 * tmask(:,:,:) 631 IF( jnt == nrdttrc ) CALL iom_put( "ExpFe2", zw3d ) 632 zw3d(:,:,:) = sinksil (:,:,:) * zrfact2 * tmask(:,:,:) 633 IF( jnt == nrdttrc ) CALL iom_put( "ExpSi", zw3d ) 634 zw3d(:,:,:) = sinkcal (:,:,:) * zrfact2 * tmask(:,:,:) 635 IF( jnt == nrdttrc ) CALL iom_put( "Expcal", zw3d ) 636 # endif 608 IF( jnt == nrdttrc ) then 609 CALL iom_put( "EPC100" , ( sinking(:,:,ik1) + sinking2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of carbon at 100m 610 CALL iom_put( "EPFE100" , ( sinkfer(:,:,ik1) + sinkfer2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of iron at 100m 611 CALL iom_put( "EPCAL100", sinkcal(:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! Export of calcite at 100m 612 CALL iom_put( "EPSI100" , sinksil(:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! Export of biogenic silica at 100m 613 ENDIF 614 #endif 637 615 #endif 638 616 ! -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90
r1678 r2007 38 38 LOGICAL :: ln_pisdmp !: relaxation or not of nutrients to a mean value 39 39 !: when initialize from a restart file 40 LOGICAL :: ln_pisclo !: Restoring or not of nutrients to initial value 41 !: on close seas 40 42 41 43 !!* Biological fluxes for light … … 62 64 #if defined key_trc_dia3d 63 65 REAL(wp), DIMENSION(jpi,jpj,jpk) :: prodcal !: Calcite production 66 REAL(wp), DIMENSION(jpi,jpj,jpk) :: grazing !: Total zooplankton grazing 64 67 #endif 65 68 -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
r1542 r2007 38 38 no3 = 31.04e-6 * 7.6 39 39 40 # include "domzgr_substitute.h90"41 40 # include "top_substitute.h90" 42 41 !!---------------------------------------------------------------------- -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/trclsm_pisces.F90
r1581 r2007 67 67 NAMELIST/nampisdia/ nwritedia, pisdia3d, pisdia2d ! additional diagnostics 68 68 #endif 69 NAMELIST/nampisdmp/ ln_pisdmp 69 NAMELIST/nampisdmp/ ln_pisdmp, ln_pisclo 70 70 71 71 !!---------------------------------------------------------------------- … … 188 188 WRITE(numout,*) 189 189 WRITE(numout,*) ' Namelist : nampisdmp' 190 WRITE(numout,*) ' Relaxation of tracer to glodap mean value ln_pisdmp =', ln_pisdmp 190 WRITE(numout,*) ' Relaxation of tracer to glodap mean value ln_pisdmp =', ln_pisdmp 191 WRITE(numout,*) ' Restoring of tracer to initial value on closed seas ln_pisclo =', ln_pisclo 191 192 WRITE(numout,*) ' ' 192 193 ENDIF -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r1445 r2007 53 53 54 54 !! * Substitutions 55 # include " domzgr_substitute.h90"55 # include "top_substitute.h90" 56 56 !!---------------------------------------------------------------------- 57 57 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf_imp.F90
r1271 r2007 112 112 rdttrc(:) = rdttra(:) * FLOAT(ndttrc) 113 113 ENDIF 114 ! ! =========== 114 115 ! Initialisation 116 zwd( 1 ,:,:) = 0.e0 ; zwd(jpi,:,:) = 0.e0 117 zws( 1 ,:,:) = 0.e0 ; zws(jpi,:,:) = 0.e0 118 zwi( 1 ,:,:) = 0.e0 ; zwi(jpi,:,:) = 0.e0 119 ! 120 ! 0. Matrix construction 121 ! ---------------------- 122 123 ! Diagonal, inferior, superior 124 ! (including the bottom boundary condition via avs masked 125 DO jk = 1, jpkm1 126 DO jj = 2, jpjm1 127 DO ji = fs_2, fs_jpim1 ! vector opt. 128 zwi(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk ) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk ) ) 129 zws(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk+1) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) ) 130 zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk) 131 END DO 132 END DO 133 END DO 134 135 ! Surface boudary conditions 136 DO jj = 2, jpjm1 137 DO ji = fs_2, fs_jpim1 138 zwi(ji,jj,1) = 0.e0 139 zwd(ji,jj,1) = 1. - zws(ji,jj,1) 140 END DO 141 END DO 142 143 ! ! =========== 115 144 DO jn = 1, jptra ! tracer loop 116 145 ! ! =========== 117 146 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! ??? validation needed 118 147 119 ! Initialisation120 zwd( 1 ,:,:) = 0.e0 ; zwd(jpi,:,:) = 0.e0121 zws( 1 ,:,:) = 0.e0 ; zws(jpi,:,:) = 0.e0122 zwi( 1 ,:,:) = 0.e0 ; zwi(jpi,:,:) = 0.e0123 148 zwt( 1 ,:,:) = 0.e0 ; zwt(jpi,:,:) = 0.e0 124 149 zwt( :,:,1) = 0.e0 ; zwt( :,:,jpk) = 0.e0 125 !126 ! 0. Matrix construction127 ! ----------------------128 129 ! Diagonal, inferior, superior130 ! (including the bottom boundary condition via avs masked131 DO jk = 1, jpkm1132 DO jj = 2, jpjm1133 DO ji = fs_2, fs_jpim1 ! vector opt.134 zwi(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk ) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk ) )135 zws(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk+1) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) )136 zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk)137 END DO138 END DO139 END DO140 141 ! Surface boudary conditions142 DO jj = 2, jpjm1143 DO ji = fs_2, fs_jpim1144 zwi(ji,jj,1) = 0.e0145 zwd(ji,jj,1) = 1. - zws(ji,jj,1)146 END DO147 END DO148 150 149 151 ! Second member construction -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf_iso.F90
r1271 r2007 182 182 183 183 184 185 DO jn = 1, jptra 184 ! 0.2 Update and save of avt (and avs if double diffusive mixing) 185 ! --------------------------- 186 187 DO jj = 2, jpjm1 ! Vertical slab 188 ! ! =============== 189 DO jk = 2, jpkm1 190 DO ji = 2, jpim1 191 zavi = fsahtw(ji,jj,jk)*( wslpi(ji,jj,jk)*wslpi(ji,jj,jk) & 192 & +wslpj(ji,jj,jk)*wslpj(ji,jj,jk) ) 193 ! add isopycnal vertical coeff. to avs 194 fstravs(ji,jj,jk) = fstravs(ji,jj,jk) + zavi 195 END DO 196 END DO 197 ! 198 END DO 199 200 201 202 DO jn = 1, jptra 186 203 187 204 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends … … 262 279 END DO 263 280 264 265 ! I.3 update and save of avt (and avs if double diffusive mixing)266 ! ---------------------------267 268 DO jk = 2, jpkm1269 DO ji = 2, jpim1270 271 zavi = fsahtw(ji,jj,jk)*( wslpi(ji,jj,jk)*wslpi(ji,jj,jk) &272 & +wslpj(ji,jj,jk)*wslpj(ji,jj,jk) )273 274 ! add isopycnal vertical coeff. to avs275 fstravs(ji,jj,jk) = fstravs(ji,jj,jk) + zavi276 277 END DO278 END DO279 281 280 282 #if defined key_trcldf_eiv -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf_iso_vopt.F90
r1328 r2007 154 154 zws => va ! workspace 155 155 INTEGER, INTENT( in ) :: kt ! ocean time-step index 156 INTEGER :: ji, jj, jk, jn ! dummy loop indices156 INTEGER :: ji, jj, jk, jn ! dummy loop indices 157 157 REAL(wp) :: zavi, zrhs ! temporary scalars 158 158 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & … … 180 180 ENDIF 181 181 182 183 zwd ( 1, :, : ) = 0.e0 ; zwd ( jpi, :, : ) = 0.e0 184 zws ( 1, :, : ) = 0.e0 ; zws ( jpi, :, : ) = 0.e0 185 zwi ( 1, :, : ) = 0.e0 ; zwi ( jpi, :, : ) = 0.e0 186 zwt ( 1, :, : ) = 0.e0 ; zwt ( jpi, :, : ) = 0.e0 187 zwt ( :, :, 1 ) = 0.e0 ; zwt ( :, :, jpk ) = 0.e0 188 zavsi( 1, :, : ) = 0.e0 ; zavsi( jpi, :, : ) = 0.e0 189 zavsi( :, :, 1 ) = 0.e0 ; zavsi( :, :, jpk ) = 0.e0 190 191 192 ! II. Vertical trend associated with the vertical physics 193 !======================================================= 194 ! (including the vertical flux proportional to dk[t] associated 195 ! with the lateral mixing, through the avt update) 196 ! dk[ avt dk[ (t,s) ] ] diffusive trends 197 198 ! II.0 Matrix construction 199 ! ------------------------ 200 ! update and save of avt (and avs if double diffusive mixing) 201 DO jk = 2, jpkm1 202 DO jj = 2, jpjm1 203 DO ji = fs_2, fs_jpim1 ! vector opt. 204 zavi = fsahtw(ji,jj,jk) * ( & ! vertical mixing coef. due to lateral mixing 205 & wslpi(ji,jj,jk) * wslpi(ji,jj,jk) & 206 & + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) 207 zavsi(ji,jj,jk) = fstravs(ji,jj,jk) + zavi ! dd mixing: zavsi = total vertical mixing coef. on tracer 208 END DO 209 END DO 210 END DO 211 212 ! II.1 Vertical diffusion on tracer 213 ! --------------------------------- 214 ! Rebuild the Matrix as avt /= avs 215 216 ! Diagonal, inferior, superior (including the bottom boundary condition via avs masked) 217 DO jk = 1, jpkm1 218 DO jj = 2, jpjm1 219 DO ji = fs_2, fs_jpim1 ! vector opt. 220 zwi(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk ) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk ) ) 221 zws(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk+1) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) ) 222 zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk) 223 END DO 224 END DO 225 END DO 226 227 ! Surface boudary conditions 228 DO jj = 2, jpjm1 229 DO ji = fs_2, fs_jpim1 ! vector opt. 230 zwi(ji,jj,1) = 0.e0 231 zwd(ji,jj,1) = 1. - zws(ji,jj,1) 232 END DO 233 END DO 234 235 !! Matrix inversion from the first level 236 !!---------------------------------------------------------------------- 237 ! solve m.x = y where m is a tri diagonal matrix ( jpk*jpk ) 238 ! 239 ! ( zwd1 zws1 0 0 0 )( zwx1 ) ( zwy1 ) 240 ! ( zwi2 zwd2 zws2 0 0 )( zwx2 ) ( zwy2 ) 241 ! ( 0 zwi3 zwd3 zws3 0 )( zwx3 )=( zwy3 ) 242 ! ( ... )( ... ) ( ... ) 243 ! ( 0 0 0 zwik zwdk )( zwxk ) ( zwyk ) 244 ! 245 ! m is decomposed in the product of an upper and lower triangular 246 ! matrix 247 ! The 3 diagonal terms are in 2d arrays: zwd, zws, zwi 248 ! The second member is in 2d array zwy 249 ! The solution is in 2d array zwx 250 ! The 3d arry zwt is a work space array 251 ! zwy is used and then used as a work space array : its value is modified! 252 253 ! first recurrence: Tk = Dk - Ik Sk-1 / Tk-1 (increasing k) 254 DO jj = 2, jpjm1 255 DO ji = fs_2, fs_jpim1 256 zwt(ji,jj,1) = zwd(ji,jj,1) 257 END DO 258 END DO 259 DO jk = 2, jpkm1 260 DO jj = 2, jpjm1 261 DO ji = fs_2, fs_jpim1 262 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1)/zwt(ji,jj,jk-1) 263 END DO 264 END DO 265 END DO 266 182 267 IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 183 268 … … 187 272 188 273 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends 189 190 zwd ( 1, :, : ) = 0.e0 ; zwd ( jpi, :, : ) = 0.e0191 zws ( 1, :, : ) = 0.e0 ; zws ( jpi, :, : ) = 0.e0192 zwi ( 1, :, : ) = 0.e0 ; zwi ( jpi, :, : ) = 0.e0193 zwt ( 1, :, : ) = 0.e0 ; zwt ( jpi, :, : ) = 0.e0194 zwt ( :, :, 1 ) = 0.e0 ; zwt ( :, :, jpk ) = 0.e0195 zavsi( 1, :, : ) = 0.e0 ; zavsi( jpi, :, : ) = 0.e0196 zavsi( :, :, 1 ) = 0.e0 ; zavsi( :, :, jpk ) = 0.e0197 274 198 275 # if defined key_trc_diatrd … … 200 277 ztrd(:,:,:) = tra(:,:,:,jn) 201 278 # endif 202 203 ! II. Vertical trend associated with the vertical physics204 ! =======================================================205 ! (including the vertical flux proportional to dk[t] associated206 ! with the lateral mixing, through the avt update)207 ! dk[ avt dk[ (t,s) ] ] diffusive trends208 209 210 ! II.0 Matrix construction211 ! ------------------------212 ! update and save of avt (and avs if double diffusive mixing)213 DO jk = 2, jpkm1214 DO jj = 2, jpjm1215 DO ji = fs_2, fs_jpim1 ! vector opt.216 zavi = fsahtw(ji,jj,jk) * ( & ! vertical mixing coef. due to lateral mixing217 & wslpi(ji,jj,jk) * wslpi(ji,jj,jk) &218 & + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) )219 zavsi(ji,jj,jk) = fstravs(ji,jj,jk) + zavi ! dd mixing: zavsi = total vertical mixing coef. on tracer220 221 END DO222 END DO223 END DO224 225 226 ! II.1 Vertical diffusion on tracer227 ! ---------------------------------228 229 ! Rebuild the Matrix as avt /= avs230 231 ! Diagonal, inferior, superior (including the bottom boundary condition via avs masked)232 DO jk = 1, jpkm1233 DO jj = 2, jpjm1234 DO ji = fs_2, fs_jpim1 ! vector opt.235 zwi(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk ) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk ) )236 zws(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk+1) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) )237 zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk)238 END DO239 END DO240 END DO241 242 ! Surface boudary conditions243 DO jj = 2, jpjm1244 DO ji = fs_2, fs_jpim1 ! vector opt.245 zwi(ji,jj,1) = 0.e0246 zwd(ji,jj,1) = 1. - zws(ji,jj,1)247 END DO248 END DO249 250 !! Matrix inversion from the first level251 !!----------------------------------------------------------------------252 ! solve m.x = y where m is a tri diagonal matrix ( jpk*jpk )253 !254 ! ( zwd1 zws1 0 0 0 )( zwx1 ) ( zwy1 )255 ! ( zwi2 zwd2 zws2 0 0 )( zwx2 ) ( zwy2 )256 ! ( 0 zwi3 zwd3 zws3 0 )( zwx3 )=( zwy3 )257 ! ( ... )( ... ) ( ... )258 ! ( 0 0 0 zwik zwdk )( zwxk ) ( zwyk )259 !260 ! m is decomposed in the product of an upper and lower triangular261 ! matrix262 ! The 3 diagonal terms are in 2d arrays: zwd, zws, zwi263 ! The second member is in 2d array zwy264 ! The solution is in 2d array zwx265 ! The 3d arry zwt is a work space array266 ! zwy is used and then used as a work space array : its value is modified!267 268 ! first recurrence: Tk = Dk - Ik Sk-1 / Tk-1 (increasing k)269 DO jj = 2, jpjm1270 DO ji = fs_2, fs_jpim1271 zwt(ji,jj,1) = zwd(ji,jj,1)272 END DO273 END DO274 DO jk = 2, jpkm1275 DO jj = 2, jpjm1276 DO ji = fs_2, fs_jpim1277 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1)278 END DO279 END DO280 END DO281 279 282 280 ! second recurrence: Zk = Yk - Ik / Tk-1 Zk-1 -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/par_trc.F90
r1254 r2007 18 18 USE par_lobster ! LOBSTER model 19 19 USE par_pisces ! PISCES model 20 USE par_c14b ! C14 bomb tracer 20 21 USE par_cfc ! CFC 11 and 12 tracers 21 USE par_c14b ! C14 bomb tracer22 22 USE par_my_trc ! user defined passive tracers 23 23 … … 27 27 ! Passive tracers : Total size 28 28 ! --------------- ! total number of passive tracers, of 2d and 3d output and trend arrays 29 INTEGER, PUBLIC, PARAMETER :: jptra = jp_lobster + jp_pisces + jp_cfc + jp_ c14b + jp_my_trc30 INTEGER, PUBLIC, PARAMETER :: jpdia2d = jp_lobster_2d + jp_pisces_2d + jp_cfc_2d + jp_ c14b_2d + jp_my_trc_2d31 INTEGER, PUBLIC, PARAMETER :: jpdia3d = jp_lobster_3d + jp_pisces_3d + jp_cfc_3d + jp_ c14b_3d + jp_my_trc_3d29 INTEGER, PUBLIC, PARAMETER :: jptra = jp_lobster + jp_pisces + jp_cfc + jp_my_trc 30 INTEGER, PUBLIC, PARAMETER :: jpdia2d = jp_lobster_2d + jp_pisces_2d + jp_cfc_2d + jp_my_trc_2d 31 INTEGER, PUBLIC, PARAMETER :: jpdia3d = jp_lobster_3d + jp_pisces_3d + jp_cfc_3d + jp_my_trc_3d 32 32 ! ! total number of sms diagnostic arrays 33 INTEGER, PUBLIC, PARAMETER :: jpdiabio = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd + jp_ c14b_trd + jp_my_trc_trd33 INTEGER, PUBLIC, PARAMETER :: jpdiabio = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd + jp_my_trc_trd 34 34 35 35 ! 1D configuration ("key_c1d") … … 40 40 LOGICAL, PUBLIC, PARAMETER :: lk_trc_c1d = .FALSE. !: 1D pass. tracer configuration flag 41 41 # endif 42 43 42 ! Passive tracers : size for TRP trends diagnotics (used if 'key_trc_diatrd' defined) 44 #if defined key_trcldf_eiv 45 # if defined key_trcdmp 46 INTEGER, PARAMETER :: jpdiatrc = 11 !: trends: 3*(advection + diffusion + eiv ) + damping + sms 47 # else 48 INTEGER, PARAMETER :: jpdiatrc = 10 !: trends: 3*(advection + diffusion + eiv ) + sms 49 # endif 50 #else 51 # if defined key_trcdmp 52 INTEGER, PARAMETER :: jpdiatrc = 8 !: trends: 3*(advection + diffusion ) + damping + sms 53 # else 54 INTEGER, PARAMETER :: jpdiatrc = 7 !: trends: 3*(advection + diffusion ) + damping + sms 55 # endif 43 # if defined key_trc_diatrd 44 ! Passive tracers : size for TRP trends diagnotics (used if 'key_trc_diatrd' defined) 45 INTEGER, PARAMETER :: jptrc_xad = 1 !: x- horizontal advection 46 INTEGER, PARAMETER :: jptrc_yad = 2 !: y- horizontal advection 47 INTEGER, PARAMETER :: jptrc_zad = 3 !: z- vertical advection 48 INTEGER, PARAMETER :: jptrc_xdf = 4 !: lateral diffusion 49 INTEGER, PARAMETER :: jptrc_ydf = 5 !: lateral diffusion 50 INTEGER, PARAMETER :: jptrc_zdf = 6 !: vertical diffusion (Kz) 51 INTEGER, PARAMETER :: jptrc_sbc = 7 !: surface boundary condition 52 #if ! defined key_trcldf_eiv && ! defined key_trcdmp 53 INTEGER, PARAMETER :: jpdiatrc = 7 !: trends: 3*(advection + diffusion ) + sbc 54 #endif 55 #if defined key_trcldf_eiv && defined key_trcdmp 56 INTEGER, PARAMETER :: jptrc_xei = 8 !: x- horiz. EIV advection 57 INTEGER, PARAMETER :: jptrc_yei = 9 !: y- horiz. EIV advection 58 INTEGER, PARAMETER :: jptrc_zei = 10 !: z- vert. EIV advection 59 INTEGER, PARAMETER :: jptrc_dmp = 11 !: damping 60 INTEGER, PARAMETER :: jpdiatrc = 11 !: trends: 3*(advection + diffusion + eiv ) + sbc + damping 61 #endif 62 #if defined key_trcldf_eiv && ! defined key_trcdmp 63 INTEGER, PARAMETER :: jptrc_xei = 8 !: x- horiz. EIV advection 64 INTEGER, PARAMETER :: jptrc_yei = 9 !: y- horiz. EIV advection 65 INTEGER, PARAMETER :: jptrc_zei = 10 !: z- vert. EIV advection 66 INTEGER, PARAMETER :: jpdiatrc = 10 !: trends: 3*(advection + diffusion + eiv ) + sbc 67 #endif 68 #if ! defined key_trcldf_eiv && defined key_trcdmp 69 INTEGER, PARAMETER :: jptrc_dmp = 8 !: damping 70 INTEGER, PARAMETER :: jpdiatrc = 8 !: trends: 3*(advection + diffusion ) + sbc + damping 71 #endif 56 72 #endif 57 73 -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/trcdia.F90
r1715 r2007 25 25 USE trc 26 26 USE trp_trc 27 USE par_trc 27 28 USE trdmld_trc_oce, ONLY : luttrd 28 29 USE dianam ! build name of file (routine) … … 41 42 INTEGER :: ndimt50 !: number of ocean points in index array 42 43 INTEGER :: ndimt51 !: number of ocean points in index array 43 REAL(wp) :: xjulian !: ???? not DOCTOR !44 REAL(wp) :: zjulian !: ???? not DOCTOR ! 44 45 INTEGER , DIMENSION (jpij*jpk) :: ndext50 !: integer arrays for ocean 3D index 45 46 INTEGER , DIMENSION (jpij) :: ndext51 !: integer arrays for ocean surface index … … 157 158 158 159 ! Compute julian date from starting date of the run 159 CALL ymds2ju( nyear, nmonth, nday, rdt, xjulian )160 xjulian = xjulian - adatrj ! set calendar origin to the beginning of the experiment160 CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) 161 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 161 162 IF(lwp)WRITE(numout,*)' ' 162 163 IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000 & 163 164 & ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday & 164 & ,'Julian day : ', xjulian165 & ,'Julian day : ', zjulian 165 166 166 167 IF(lwp) WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma, & … … 171 172 IF(lwp) THEN 172 173 CALL dia_nam( clhstnam, nwritetrc,' ' ) 173 CALL ctl _opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )174 CALL ctlopn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, narea ) 174 175 WRITE(inum,*) clhstnam 175 176 CLOSE(inum) … … 184 185 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 185 186 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 186 & nittrc000-ndttrc, xjulian, zdt, nhorit5, nit5 , domain_id=nidom)187 & nittrc000-ndttrc, zjulian, zdt, nhorit5, nit5 , domain_id=nidom) 187 188 188 189 ! Vertical grid for tracer : gdept … … 258 259 CHARACTER (len=80) :: cltral 259 260 CHARACTER (len=10) :: csuff 260 INTEGER :: jn, jl 261 INTEGER :: jn, jl, ikn 261 262 INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod 262 263 REAL(wp) :: zsto, zout, zdt … … 313 314 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 314 315 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 315 & nittrc000-ndttrc, xjulian, zdt, nhorit6(jn), &316 & nittrc000-ndttrc, zjulian, zdt, nhorit6(jn), & 316 317 & nit6(jn) , domain_id=nidom ) 317 318 … … 322 323 323 324 ! Declare all the output fields as NETCDF variables 324 325 ! trends for tracer concentrations326 325 DO jn = 1, jptra 327 326 IF( luttrd(jn) ) THEN 328 327 DO jl = 1, jpdiatrc 329 IF( jl == 1) THEN328 IF( jl == jptrc_xad ) THEN 330 329 ! short and long title for x advection for tracer 331 330 WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 332 WRITE (cltral,'("X advective trend for ",58a)') & 333 & ctrcnl(jn)(1:58) 334 END IF 335 IF( jl == 2 ) THEN 331 WRITE (cltral,'("X advective trend for ",58a)') ctrcnl(jn)(1:58) 332 END IF 333 IF( jl == jptrc_yad ) THEN 336 334 ! short and long title for y advection for tracer 337 335 WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 338 WRITE (cltral,'("Y advective trend for ",58a)') & 339 & ctrcnl(jn)(1:58) 340 END IF 341 IF( jl == 3 ) THEN 336 WRITE (cltral,'("Y advective trend for ",58a)') ctrcnl(jn)(1:58) 337 END IF 338 IF( jl == jptrc_zad ) THEN 342 339 ! short and long title for Z advection for tracer 343 340 WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 344 WRITE (cltral,'("Z advective trend for ",58a)') & 345 & ctrcnl(jn)(1:58) 346 END IF 347 IF( jl == 4 ) THEN 341 WRITE (cltral,'("Z advective trend for ",58a)') ctrcnl(jn)(1:58) 342 END IF 343 IF( jl == jptrc_xdf ) THEN 348 344 ! short and long title for X diffusion for tracer 349 345 WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 350 WRITE (cltral,'("X diffusion trend for ",58a)') & 351 & ctrcnl(jn)(1:58) 352 END IF 353 IF( jl == 5 ) THEN 346 WRITE (cltral,'("X diffusion trend for ",58a)') ctrcnl(jn)(1:58) 347 END IF 348 IF( jl == jptrc_ydf ) THEN 354 349 ! short and long title for Y diffusion for tracer 355 350 WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 356 WRITE (cltral,'("Y diffusion trend for ",58a)') & 357 & ctrcnl(jn)(1:58) 358 END IF 359 IF( jl == 6 ) THEN 351 WRITE (cltral,'("Y diffusion trend for ",58a)') ctrcnl(jn)(1:58) 352 END IF 353 IF( jl == jptrc_zdf ) THEN 360 354 ! short and long title for Z diffusion for tracer 361 355 WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 362 WRITE (cltral,'("Z diffusion trend for ",58a)') & 363 & ctrcnl(jn)(1:58) 356 WRITE (cltral,'("Z diffusion trend for ",58a)') ctrcnl(jn)(1:58) 364 357 END IF 365 358 # if defined key_trcldf_eiv 366 IF( jl == 7) THEN359 IF( jl == jptrc_xei ) THEN 367 360 ! short and long title for x gent velocity for tracer 368 361 WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) 369 WRITE (cltral,'("X gent velocity trend for ",53a)') & 370 & ctrcnl(jn)(1:53) 371 END IF 372 IF( jl == 8 ) THEN 362 WRITE (cltral,'("X gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 363 END IF 364 IF( jl == jptrc_yei ) THEN 373 365 ! short and long title for y gent velocity for tracer 374 366 WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 375 WRITE (cltral,'("Y gent velocity trend for ",53a)') & 376 & ctrcnl(jn)(1:53) 377 END IF 378 IF( jl == 9 ) THEN 367 WRITE (cltral,'("Y gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 368 END IF 369 IF( jl == jptrc_zei ) THEN 379 370 ! short and long title for Z gent velocity for tracer 380 371 WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 381 WRITE (cltral,'("Z gent velocity trend for ",53a)') & 382 & ctrcnl(jn)(1:53) 372 WRITE (cltral,'("Z gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 383 373 END IF 384 374 # endif 385 375 # if defined key_trcdmp 386 IF( jl == jp diatrc - 1) THEN376 IF( jl == jptrc_dmp ) THEN 387 377 ! last trends for tracer damping : short and long title 388 378 WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 389 WRITE (cltral,'("Tracer damping trend for ",55a)') & 390 & ctrcnl(jn)(1:55) 391 END IF 392 # endif 393 IF( jl == jpdiatrc ) THEN 379 WRITE (cltral,'("Tracer damping trend for ",55a)') ctrcnl(jn)(1:55) 380 END IF 381 # endif 382 IF( jl == jptrc_sbc ) THEN 394 383 ! last trends for tracer damping : short and long title 395 384 WRITE (cltra,'("SBC_",16a)') ctrcnm(jn) 396 WRITE (cltral,'("Surface boundary flux ",58a)') &397 & ctrcnl(jn)(1:58)398 END IF399 385 WRITE (cltral,'("Surface boundary flux ",58a)') ctrcnl(jn)(1:55) 386 END IF 387 WRITE (cltral,'("Surface boundary flux ",58a)') ctrcnl(jn)(1:55) 388 END IF 400 389 CALL FLUSH( numout ) 401 390 cltrau = ctrcun(jn) ! UNIT for tracer /trends … … 406 395 END IF 407 396 END DO 408 409 397 ! CLOSE netcdf Files 410 398 DO jn = 1, jptra … … 432 420 DO jn = 1, jptra 433 421 IF( luttrd(jn) ) THEN 422 ikn = ikeep(jn) 434 423 DO jl = 1, jpdiatrc 435 ! short titles 436 IF( jl == 1) WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) ! x advection for tracer437 IF( jl == 2) WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) ! z advection for tracer438 IF( jl == 3) WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) ! z advection for tracer439 IF( jl == 4) WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) ! x diffusion for tracer440 IF( jl == 5) WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) ! y diffusion for tracer441 IF( jl == 6) WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) ! z diffusion for tracer424 ! short titles 425 IF( jl == jptrc_xad) WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 426 IF( jl == jptrc_yad) WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 427 IF( jl == jptrc_zad) WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 428 IF( jl == jptrc_xdf) WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 429 IF( jl == jptrc_ydf) WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 430 IF( jl == jptrc_zdf) WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 442 431 # if defined key_trcldf_eiv 443 IF( jl == 7) WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) ! x gent velocity for tracer444 IF( jl == 8) WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) ! y gent velocity for tracer445 IF( jl == 9) WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) ! z gent velocity for tracer432 IF( jl == jptrc_xei) WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) 433 IF( jl == jptrc_yei) WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 434 IF( jl == jptrc_zei) WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 446 435 # endif 447 436 # if defined key_trcdmp 448 IF( jl == jp diatrc - 1 ) WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) ! damping449 # endif 450 IF( jl == jp diatrc ) WRITE (cltra,'("SBC_",a)') ctrcnm(jn) ! surface boundary conditions437 IF( jl == jptrc_dmp ) WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 438 # endif 439 IF( jl == jptrc_sbc ) WRITE (cltra,'("SBC_",16a)') ctrcnm(jn) 451 440 ! 452 CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ik eep(jn),jl),ndimt50, ndext50)441 CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ikn,jl),ndimt50, ndext50) 453 442 END DO 454 443 END IF … … 552 541 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 553 542 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 554 & nittrc000-ndttrc, xjulian, zdt, nhoritd, nitd , domain_id=nidom )543 & nittrc000-ndttrc, zjulian, zdt, nhoritd, nitd , domain_id=nidom ) 555 544 556 545 ! Vertical grid for 2d and 3d arrays … … 700 689 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 701 690 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 702 & nittrc000-ndttrc, xjulian, zdt, nhoritb, nitb , domain_id=nidom )691 & nittrc000-ndttrc, zjulian, zdt, nhoritb, nitb , domain_id=nidom ) 703 692 ! Vertical grid for biological trends 704 693 CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepitb) -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r1645 r2007 25 25 PUBLIC trc_dta ! called in trcini.F90 and trcdmp.F90 26 26 27 LOGICAL , PUBLIC, PARAMETER :: lk_dtatrc = .TRUE. !: temperature data flag 27 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jptra) :: trdta !: tracer data at given time-step 28 29 … … 62 63 !! 63 64 CHARACTER (len=39) :: clname(jptra) 64 INTEGER, PARAMETER :: jpmois = 12 ! number of months 65 INTEGER, PARAMETER :: & 66 jpmonth = 12 ! number of months 65 67 INTEGER :: ji, jj, jn, jl 66 68 INTEGER :: imois, iman, i15, ik ! temporary integers … … 81 83 ENDIF 82 84 ! Initialization 83 iman = jpmo is85 iman = jpmonth 84 86 i15 = nday / 16 85 87 imois = nmonth + i15 -1 … … 188 190 ! Read init file only 189 191 IF( kt == nittrc000 ) THEN 192 ntrc1(jn) = 1 190 193 CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), trdta(:,:,:,jn), ntrc1(jn) ) 191 194 trdta(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:) … … 204 207 !! Dummy module NO 3D passive tracer data 205 208 !!---------------------------------------------------------------------- 209 LOGICAL , PUBLIC, PARAMETER :: lk_dtatrc = .FALSE. !: temperature data flag 206 210 CONTAINS 207 211 SUBROUTINE trc_dta( kt ) ! Empty routine -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r1745 r2007 122 122 trb(:,:,:,:) = trn(:,:,:,:) 123 123 ELSE 124 ! 124 125 CALL trc_rst_read ! restart from a file 125 #if defined key_off_tra 126 CALL day_init ! calendar 127 #endif 126 ! 128 127 ENDIF 129 128 -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r1655 r2007 1 1 MODULE trcrst 2 2 !!====================================================================== 3 !! *** MODULE trcrst ***4 !! TOP : create, write, read the restart files for passive tracers3 !! *** MODULE trcrst *** 4 !! TOP : Manage the passive tracer restart 5 5 !!====================================================================== 6 !! History : 1.0 ! 2007-02 (C. Ethe) adaptation from the ocean 6 !! History : - ! 1991-03 () original code 7 !! 1.0 ! 2005-03 (O. Aumont, A. El Moussaoui) F90 8 !! - ! 2005-10 (C. Ethe) print control 9 !! 2.0 ! 2005-10 (C. Ethe, G. Madec) revised architecture 7 10 !!---------------------------------------------------------------------- 8 11 #if defined key_top 12 !!---------------------------------------------------------------------- 13 !! 'key_top' TOP models 14 !!---------------------------------------------------------------------- 15 !!---------------------------------------------------------------------- 16 !! trc_rst : Restart for passive tracer 17 !!---------------------------------------------------------------------- 9 18 !!---------------------------------------------------------------------- 10 19 !! 'key_top' TOP models … … 16 25 USE oce_trc 17 26 USE trc 18 USE sms_lobster ! LOBSTER variables 19 USE sms_pisces ! PISCES variables 20 USE trcsms_cfc ! CFC variables 21 USE trcsms_c14b ! C14 variables 22 USE trcsms_my_trc ! MY_TRC variables 23 USE trctrp_lec 27 USE trctrp_lec 24 28 USE lib_mpp 25 29 USE iom 26 30 USE trcrst_cfc ! CFC 31 USE trcrst_lobster ! LOBSTER restart 32 USE trcrst_pisces ! PISCES restart 33 USE trcrst_c14b ! C14 bomb restart 34 USE trcrst_my_trc ! MY_TRC restart 35 #if defined key_off_tra 36 USE daymod 37 #endif 27 38 IMPLICIT NONE 28 39 PRIVATE 29 40 30 41 PUBLIC trc_rst_opn ! called by ??? 31 42 PUBLIC trc_rst_read ! called by ??? 32 43 PUBLIC trc_rst_wri ! called by ??? 33 44 34 45 INTEGER, PUBLIC :: numrtr, numrtw !: logical unit for trc restart (read and write) 35 36 46 37 47 !! * Substitutions … … 89 99 END SUBROUTINE trc_rst_opn 90 100 91 92 SUBROUTINE trc_rst_read 101 SUBROUTINE trc_rst_read 93 102 !!---------------------------------------------------------------------- 94 103 !! *** trc_rst_opn *** … … 96 105 !! ** purpose : read passive tracer fields in restart files 97 106 !!---------------------------------------------------------------------- 98 INTEGER :: jn 99 INTEGER :: iarak0 107 INTEGER :: jn 108 INTEGER :: iarak0 100 109 REAL(wp) :: zarak0 101 110 INTEGER :: jlibalt = jprstlib 102 111 LOGICAL :: llok 103 #if defined key_pisces104 INTEGER :: ji, jj, jk105 REAL(wp) :: zcaralk, zbicarb, zco3106 REAL(wp) :: ztmas, ztmas1107 #endif108 112 109 113 !!---------------------------------------------------------------------- … … 115 119 IF ( jprstlib == jprstdimg ) THEN 116 120 ! eventually read netcdf file (monobloc) for restarting on different number of processors 117 ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90 121 ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90 118 122 INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok ) 119 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF 120 ENDIF 121 122 CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt ) 123 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF 124 ENDIF 125 126 CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt ) 123 127 124 128 ! Time domain : restart … … 136 140 & ' centered or euler ' ) 137 141 IF(lwp) WRITE(numout,*) 138 139 142 IF(lwp) WRITE(numout,*) ' arakawa option : ', NINT( zarak0 ) 140 143 141 142 144 ! READ prognostic variables and computes diagnostic variable 143 145 DO jn = 1, jptra 144 CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 145 END DO 146 147 DO jn = 1, jptra 148 CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 149 END DO 150 151 #if defined key_lobster 152 CALL iom_get( numrtr, jpdom_autoglo, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 153 CALL iom_get( numrtr, jpdom_autoglo, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 154 #endif 155 #if defined key_pisces 156 ! 157 IF( ln_pisdmp ) CALL pis_dmp_ini ! relaxation of some tracers 158 ! 159 IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN 160 CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:) ) 161 ELSE 162 ! Set PH from total alkalinity, borat (???), akb3 (???) and ak23 (???) 163 ! -------------------------------------------------------- 164 DO jk = 1, jpk 165 DO jj = 1, jpj 166 DO ji = 1, jpi 167 ztmas = tmask(ji,jj,jk) 168 ztmas1 = 1. - tmask(ji,jj,jk) 169 zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) ) 170 zco3 = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 171 zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 172 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 173 END DO 174 END DO 175 END DO 176 ENDIF 177 CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) ) 178 IF( iom_varid( numrtr, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN 179 CALL iom_get( numrtr, jpdom_autoglo, 'Silicamax' , xksimax(:,:) ) 180 ELSE 181 xksimax(:,:) = xksi(:,:) 182 ENDIF 183 #endif 184 #if defined key_cfc 185 DO jn = jp_cfc0, jp_cfc1 186 CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 187 END DO 188 #endif 189 #if defined key_c14b 190 CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn) , qint_c14(:,:) ) 191 #endif 192 #if defined key_my_trc 193 #endif 194 146 CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 147 END DO 148 149 DO jn = 1, jptra 150 CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 151 END DO 152 153 IF( lk_lobster ) CALL trc_rst_read_lobster( numrtr ) ! LOBSTER bio-model 154 IF( lk_pisces ) CALL trc_rst_read_pisces ( numrtr ) ! PISCES bio-model 155 IF( lk_cfc ) CALL trc_rst_read_cfc ( numrtr ) ! CFC tracers 156 IF( lk_c14b ) CALL trc_rst_read_c14b ( numrtr ) ! C14 bomb tracer 157 IF( lk_my_trc ) CALL trc_rst_read_my_trc ( numrtr ) ! MY_TRC tracers 158 195 159 CALL iom_close( numrtr ) 196 160 ! 197 161 END SUBROUTINE trc_rst_read 198 199 162 200 163 SUBROUTINE trc_rst_wri( kt ) … … 218 181 CALL iom_rstput( kt, nitrst, numrtw, 'arak0', zarak0 ) 219 182 220 ! prognostic variables 221 ! -------------------- 183 ! prognostic variables 184 ! -------------------- 222 185 DO jn = 1, jptra 223 186 CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) … … 228 191 END DO 229 192 230 #if defined key_lobster 231 CALL iom_rstput( kt, nitrst, numrtw, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 232 CALL iom_rstput( kt, nitrst, numrtw, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 233 #endif 234 #if defined key_pisces 235 CALL iom_rstput( kt, nitrst, numrtw, 'PH', hi(:,:,:) ) 236 CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) ) 237 CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) ) 238 #endif 239 #if defined key_cfc 240 DO jn = jp_cfc0, jp_cfc1 241 CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 242 END DO 243 #endif 244 #if defined key_c14b 245 CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_c14(:,:) ) 246 #endif 247 #if defined key_my_trc 248 #endif 249 193 IF( lk_lobster ) CALL trc_rst_wri_lobster( kt, nitrst, numrtw ) ! LOBSTER bio-model 194 IF( lk_pisces ) CALL trc_rst_wri_pisces ( kt, nitrst, numrtw ) ! PISCES bio-model 195 IF( lk_cfc ) CALL trc_rst_wri_cfc ( kt, nitrst, numrtw ) ! CFC tracers 196 IF( lk_c14b ) CALL trc_rst_wri_c14b ( kt, nitrst, numrtw ) ! C14 bomb tracer 197 IF( lk_my_trc ) CALL trc_rst_wri_my_trc ( kt, nitrst, numrtw ) ! MY_TRC tracers 198 250 199 IF( kt == nitrst ) THEN 251 200 CALL trc_rst_stat ! statistics … … 256 205 ENDIF 257 206 ! 258 END SUBROUTINE trc_rst_wri 207 END SUBROUTINE trc_rst_wri 208 259 209 260 210 SUBROUTINE trc_rst_cal( kt, cdrw ) … … 329 279 WRITE(numout,*) 330 280 ENDIF 281 ! 282 CALL day_init ! compute calendar 283 ! 331 284 #endif 332 285 … … 347 300 END SUBROUTINE trc_rst_cal 348 301 349 # if defined key_pisces350 351 SUBROUTINE pis_dmp_ini352 !!----------------------------------------------------------------------353 !! *** pis_dmp_ini ***354 !!355 !! ** purpose : Relaxation of some tracers356 !!----------------------------------------------------------------------357 INTEGER :: ji, jj, jk358 REAL(wp) :: &359 alkmean = 2426. , & ! mean value of alkalinity ( Glodap ; for Goyet 2391. )360 po4mean = 2.165 , & ! mean value of phosphates361 no3mean = 30.90 , & ! mean value of nitrate362 siomean = 91.51 ! mean value of silicate363 364 REAL(wp) :: zvol, ztrasum365 366 367 IF(lwp) WRITE(numout,*)368 369 IF( cp_cfg == "orca" .AND. .NOT. lk_trc_c1d ) THEN ! ORCA condiguration (not 1D) !370 ! ! --------------------------- !371 ! set total alkalinity, phosphate, NO3 & silicate372 373 ! total alkalinity374 ztrasum = 0.e0375 DO jk = 1, jpk376 DO jj = 1, jpj377 DO ji = 1, jpi378 zvol = cvol(ji,jj,jk)379 # if defined key_off_degrad380 zvol = zvol * facvol(ji,jj,jk)381 # endif382 ztrasum = ztrasum + trn(ji,jj,jk,jptal) * zvol383 END DO384 END DO385 END DO386 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain387 388 ztrasum = ztrasum / areatot * 1.e6389 IF(lwp) WRITE(numout,*) ' TALK mean : ', ztrasum390 trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / ztrasum391 392 ! phosphate393 ztrasum = 0.e0394 DO jk = 1, jpk395 DO jj = 1, jpj396 DO ji = 1, jpi397 zvol = cvol(ji,jj,jk)398 # if defined key_off_degrad399 zvol = zvol * facvol(ji,jj,jk)400 # endif401 ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * zvol402 END DO403 END DO404 END DO405 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain406 407 ztrasum = ztrasum / areatot * 1.e6 / 122.408 IF(lwp) WRITE(numout,*) ' PO4 mean : ', ztrasum409 trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / ztrasum410 411 ! Nitrates412 ztrasum = 0.e0413 DO jk = 1, jpk414 DO jj = 1, jpj415 DO ji = 1, jpi416 zvol = cvol(ji,jj,jk)417 # if defined key_off_degrad418 zvol = zvol * facvol(ji,jj,jk)419 # endif420 ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * zvol421 END DO422 END DO423 END DO424 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain425 426 ztrasum = ztrasum / areatot * 1.e6 / 7.6427 IF(lwp) WRITE(numout,*) ' NO3 mean : ', ztrasum428 trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / ztrasum429 430 ! Silicate431 ztrasum = 0.e0432 DO jk = 1, jpk433 DO jj = 1, jpj434 DO ji = 1, jpi435 zvol = cvol(ji,jj,jk)436 # if defined key_off_degrad437 zvol = zvol * facvol(ji,jj,jk)438 # endif439 ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * zvol440 END DO441 END DO442 END DO443 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain444 ztrasum = ztrasum / areatot * 1.e6445 IF(lwp) WRITE(numout,*) ' SiO3 mean : ', ztrasum446 trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * siomean / ztrasum )447 !448 ENDIF449 450 !#if defined key_kriest451 ! !! Initialize number of particles from a standart restart file452 ! !! The name of big organic particles jpgoc has been only change453 ! !! and replace by jpnum but the values here are concentration454 ! trn(:,:,:,jppoc) = trn(:,:,:,jppoc) + trn(:,:,:,jpnum)455 ! trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp )456 !#endif457 458 END SUBROUTINE pis_dmp_ini459 460 #endif461 !!----------------------------------------------------------------------462 302 463 303 SUBROUTINE trc_rst_stat -
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
r1656 r2007 1 1 MODULE trcwri 2 !!====================================================================== 2 !!=================================================================================== 3 3 !! *** MODULE trcwri *** 4 !! TOP : Output of passive tracers 5 !!====================================================================== 6 !! 1.0 !7 !! ! 20 09-05 (C. Ethe )4 !! TOP : Output of passive tracers 5 !!==================================================================================== 6 !! History : 1.0 ! 2009-05 (C. Ethe) Original code 7 !! ! 2010-03 (C. Ethe, R. Seferian ) Add the tracer transport trends 8 8 !!---------------------------------------------------------------------- 9 9 #if defined key_top && defined key_iomput … … 11 11 !! 'key_top' && 'key_iomput' TOP models 12 12 !!---------------------------------------------------------------------- 13 !! trc_wri : outputs of concentration fields 13 !! trc_wri_trc : outputs of concentration fields 14 !! trc_wri_trd : outputs of transport trends 14 15 !!---------------------------------------------------------------------- 16 USE dom_oce ! ocean space and time domain variables 17 USE oce_trc 18 USE trp_trc 15 19 USE trc 20 USE trdmld_trc_oce, ONLY : luttrd 16 21 USE iom 17 22 #if defined key_off_tra … … 35 40 CONTAINS 36 41 37 SUBROUTINE trc_wri( kt ) 42 SUBROUTINE trc_wri( kt ) 38 43 !!--------------------------------------------------------------------- 39 44 !! *** ROUTINE trc_wri *** 45 !! 46 !! ** Purpose : output passive tracers fields and dynamical trends 47 !!--------------------------------------------------------------------- 48 INTEGER, INTENT( in ) :: kt 49 !!--------------------------------------------------------------------- 50 51 ! 52 CALL iom_setkt ( kt + ndttrc - 1 ) ! set the passive tracer time step 53 CALL trc_wri_trc( kt ) ! outputs for tracer concentration 54 CALL trc_wri_trd( kt ) ! outputs for dynamical trends 55 CALL iom_setkt ( kt ) ! set the model time step 56 ! 57 END SUBROUTINE trc_wri 58 59 SUBROUTINE trc_wri_trc( kt ) 60 !!--------------------------------------------------------------------- 61 !! *** ROUTINE trc_wri_trc *** 40 62 !! 41 63 !! ** Purpose : output passive tracers fields … … 43 65 INTEGER, INTENT( in ) :: kt ! ocean time-step 44 66 INTEGER :: jn 45 CHARACTER (len=20) :: cltra 67 CHARACTER (len=20) :: cltra, cltras 46 68 #if defined key_off_tra 47 69 CHARACTER (len=40) :: clhstnam 48 70 INTEGER :: inum = 11 ! temporary logical unit 49 71 #endif 50 51 72 !!--------------------------------------------------------------------- 52 73 53 ! Initialisation54 ! --------------55 56 CALL iom_setkt( kt + ndttrc - 1 ) ! set the passive tracer time step57 58 74 #if defined key_off_tra 59 75 IF( kt == nittrc000 ) THEN … … 67 83 ENDIF 68 84 #endif 69 70 71 85 ! write the tracer concentrations in the file 72 86 ! --------------------------------------- … … 76 90 END DO 77 91 ! 78 CALL iom_setkt( kt ) ! set the model time step92 END SUBROUTINE trc_wri_trc 79 93 94 # if defined key_trc_diatrd 95 96 SUBROUTINE trc_wri_trd( kt ) 97 !!---------------------------------------------------------------------- 98 !! *** ROUTINE trc_wri_trd *** 99 !! 100 !! ** Purpose : output of passive tracer : advection-diffusion trends 101 !! 102 !!---------------------------------------------------------------------- 103 INTEGER, INTENT( in ) :: kt ! ocean time-step 104 !! 105 CHARACTER (len=3) :: cltra 106 INTEGER :: jn, jl, ikn 107 !!---------------------------------------------------------------------- 108 109 DO jn = 1, jptra 110 IF( luttrd(jn) ) THEN 111 ikn = ikeep(jn) 112 DO jl = 1, jpdiatrc 113 IF( jl == jptrc_xad ) WRITE (cltra,"(3a)") 'XAD' ! x advection for tracer 114 IF( jl == jptrc_yad ) WRITE (cltra,"(3a)") 'YAD' ! y advection for tracer 115 IF( jl == jptrc_zad ) WRITE (cltra,"(3a)") 'ZAD' ! z advection for tracer 116 IF( jl == jptrc_xdf ) WRITE (cltra,"(3a)") 'XDF' ! x diffusion for tracer 117 IF( jl == jptrc_ydf ) WRITE (cltra,"(3a)") 'YDF' ! y diffusion for tracer 118 IF( jl == jptrc_zdf ) WRITE (cltra,"(3a)") 'ZDF' ! z diffusion for tracer 119 # if defined key_trcldf_eiv 120 IF( jl == jptrc_xei ) WRITE (cltra,"(3a)") 'XGV' ! x gent velocity for tracer 121 IF( jl == jptrc_yei ) WRITE (cltra,"(3a)") 'YGV' ! y gent velocity for tracer 122 IF( jl == jptrc_zei ) WRITE (cltra,"(3a)") 'ZGV' ! z gent velocity for tracer 123 # endif 124 # if defined key_trcdmp 125 IF( jl == jptrc_dmp ) WRITE (cltra,"(3a)") 'DMP' ! damping 126 # endif 127 IF( jl == jptrc_sbc ) WRITE (cltra,"(3a)") 'SBC' ! surface boundary conditions 128 ! write the trends 129 CALL iom_put( cltra, trtrd(:,:,:,ikn,jl) ) 130 END DO 131 END IF 132 END DO 80 133 ! 81 END SUBROUTINE trc_wri 134 END SUBROUTINE trc_wri_trd 82 135 136 # else 137 SUBROUTINE trc_wri_trd( kt ) ! Dummy routine 138 INTEGER, INTENT ( in ) :: kt 139 END SUBROUTINE trc_wri_trd 140 #endif 83 141 #else 84 142 !!---------------------------------------------------------------------- … … 90 148 INTEGER, INTENT(in) :: kt 91 149 END SUBROUTINE trc_wri 92 93 150 #endif 94 151
Note: See TracChangeset
for help on using the changeset viewer.