- Timestamp:
- 2010-03-11T10:17:56+01:00 (14 years ago)
- Location:
- branches/CMIP5_IPSL/NEMO
- Files:
-
- 5 added
- 29 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/CMIP5_IPSL/NEMO/OFF_SRC/DOM/domrea.F90
r1641 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/C14b/trclsm_c14b.F90
r1581 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/CFC/trcctl_cfc.F90
r1255 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/CFC/trclsm_cfc.F90
r1581 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/LOBSTER/trcbio.F90
r1457 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/LOBSTER/trcexp.F90
r1457 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90
r1542 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/LOBSTER/trcopt.F90
r1445 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/LOBSTER/trcsed.F90
r1457 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zbio.F90
r1678 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zche.F90
r1180 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zflx.F90
r1737 r1808 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) -
branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zlim.F90
r1152 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zmeso.F90
r1736 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zmicro.F90
r1736 r1808 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) -
branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zmort.F90
r1736 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zopt.F90
r1678 r1808 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) -
branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zprod.F90
r1736 r1808 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) -
branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zrem.F90
r1744 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zsink.F90
r1736 r1808 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) -
branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/sms_pisces.F90
r1678 r1808 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 -
branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
r1542 r1808 38 38 no3 = 31.04e-6 * 7.6 39 39 40 # include "domzgr_substitute.h90"41 40 # include "top_substitute.h90" 42 41 !!---------------------------------------------------------------------- -
branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/trclsm_pisces.F90
r1581 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/TRP/trctrp.F90
r1445 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/TRP/trczdf_imp.F90
r1271 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/TRP/trczdf_iso.F90
r1271 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/TRP/trczdf_iso_vopt.F90
r1328 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/trcdta.F90
r1645 r1808 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/CMIP5_IPSL/NEMO/TOP_SRC/trcrst.F90
r1655 r1808 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 27 36 IMPLICIT NONE 28 37 PRIVATE 29 38 30 39 PUBLIC trc_rst_opn ! called by ??? 31 40 PUBLIC trc_rst_read ! called by ??? 32 41 PUBLIC trc_rst_wri ! called by ??? 33 42 34 43 INTEGER, PUBLIC :: numrtr, numrtw !: logical unit for trc restart (read and write) 35 36 44 37 45 !! * Substitutions … … 89 97 END SUBROUTINE trc_rst_opn 90 98 91 92 SUBROUTINE trc_rst_read 99 SUBROUTINE trc_rst_read 93 100 !!---------------------------------------------------------------------- 94 101 !! *** trc_rst_opn *** … … 96 103 !! ** purpose : read passive tracer fields in restart files 97 104 !!---------------------------------------------------------------------- 98 INTEGER :: jn 99 INTEGER :: iarak0 105 INTEGER :: jn 106 INTEGER :: iarak0 100 107 REAL(wp) :: zarak0 101 108 INTEGER :: jlibalt = jprstlib 102 109 LOGICAL :: llok 103 #if defined key_pisces104 INTEGER :: ji, jj, jk105 REAL(wp) :: zcaralk, zbicarb, zco3106 REAL(wp) :: ztmas, ztmas1107 #endif108 110 109 111 !!---------------------------------------------------------------------- … … 115 117 IF ( jprstlib == jprstdimg ) THEN 116 118 ! eventually read netcdf file (monobloc) for restarting on different number of processors 117 ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90 119 ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90 118 120 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 ) 121 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF 122 ENDIF 123 124 CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt ) 123 125 124 126 ! Time domain : restart … … 136 138 & ' centered or euler ' ) 137 139 IF(lwp) WRITE(numout,*) 138 139 140 IF(lwp) WRITE(numout,*) ' arakawa option : ', NINT( zarak0 ) 140 141 141 142 142 ! READ prognostic variables and computes diagnostic variable 143 143 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 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( lk_lobster ) CALL trc_rst_read_lobster( numrtr ) ! LOBSTER bio-model 152 IF( lk_pisces ) CALL trc_rst_read_pisces ( numrtr ) ! PISCES bio-model 153 IF( lk_cfc ) CALL trc_rst_read_cfc ( numrtr ) ! CFC tracers 154 IF( lk_c14b ) CALL trc_rst_read_c14b ( numrtr ) ! C14 bomb tracer 155 IF( lk_my_trc ) CALL trc_rst_read_my_trc ( numrtr ) ! MY_TRC tracers 156 195 157 CALL iom_close( numrtr ) 196 158 ! 197 159 END SUBROUTINE trc_rst_read 198 199 160 200 161 SUBROUTINE trc_rst_wri( kt ) … … 218 179 CALL iom_rstput( kt, nitrst, numrtw, 'arak0', zarak0 ) 219 180 220 ! prognostic variables 221 ! -------------------- 181 ! prognostic variables 182 ! -------------------- 222 183 DO jn = 1, jptra 223 184 CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) … … 228 189 END DO 229 190 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 191 IF( lk_lobster ) CALL trc_rst_wri_lobster( kt, nitrst, numrtw ) ! LOBSTER bio-model 192 IF( lk_pisces ) CALL trc_rst_wri_pisces ( kt, nitrst, numrtw ) ! PISCES bio-model 193 IF( lk_cfc ) CALL trc_rst_wri_cfc ( kt, nitrst, numrtw ) ! CFC tracers 194 IF( lk_c14b ) CALL trc_rst_wri_c14b ( kt, nitrst, numrtw ) ! C14 bomb tracer 195 IF( lk_my_trc ) CALL trc_rst_wri_my_trc ( kt, nitrst, numrtw ) ! MY_TRC tracers 196 250 197 IF( kt == nitrst ) THEN 251 198 CALL trc_rst_stat ! statistics … … 256 203 ENDIF 257 204 ! 258 END SUBROUTINE trc_rst_wri 205 END SUBROUTINE trc_rst_wri 206 259 207 260 208 SUBROUTINE trc_rst_cal( kt, cdrw ) … … 347 295 END SUBROUTINE trc_rst_cal 348 296 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 297 463 298 SUBROUTINE trc_rst_stat
Note: See TracChangeset
for help on using the changeset viewer.