Changeset 2715 for trunk/NEMOGCM/NEMO/TOP_SRC
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- Location:
- trunk/NEMOGCM/NEMO/TOP_SRC
- Files:
-
- 54 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90
r2528 r2715 5 5 !!====================================================================== 6 6 !! History : 2.0 ! 2008-12 (C. Ethe, G. Madec) revised architecture 7 !!----------------------------------------------------------------------8 !! NEMO/TOP 3.3 , NEMO Consortium (2010)9 !! $Id$10 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)11 7 !!---------------------------------------------------------------------- 12 8 USE par_lobster, ONLY : jp_lobster !: number of tracers in LOBSTER … … 55 51 56 52 ! Starting/ending C14 do-loop indices (N.B. no C14 : jp_c14b0 > jp_c14b1 the do-loop are never done) 57 INTEGER, PUBLIC, PARAMETER :: jp_c14b0 = jp_lb + 1!: First index of C14 tracer58 INTEGER, PUBLIC, PARAMETER :: jp_c14b1 = jp_lb + jp_c14b!: Last index of C14 tracer53 INTEGER, PUBLIC, PARAMETER :: jp_c14b0 = jp_lb + 1 !: First index of C14 tracer 54 INTEGER, PUBLIC, PARAMETER :: jp_c14b1 = jp_lb + jp_c14b !: Last index of C14 tracer 59 55 INTEGER, PUBLIC, PARAMETER :: jp_c14b0_2d = jp_lb_2d + 1 !: First index of C14 tracer 60 56 INTEGER, PUBLIC, PARAMETER :: jp_c14b1_2d = jp_lb_2d + jp_c14b_2d !: Last index of C14 tracer … … 64 60 INTEGER, PUBLIC, PARAMETER :: jp_c14b1_trd = jp_lb_trd + jp_c14b_trd !: Last index of C14 tracer 65 61 62 !!---------------------------------------------------------------------- 63 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 64 !! $Id$ 65 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 66 66 !!====================================================================== 67 67 END MODULE par_c14b -
trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcini_c14b.F90
r2528 r2715 4 4 !! TOP : initialisation of the C14 bomb tracer 5 5 !!====================================================================== 6 !! History : Original ! 2005-10 (Z. Lachkar)7 !! 2.0 ! 2007-12 (C. Ethe)6 !! History : 1.0 ! 2005-10 (Z. Lachkar) Original code 7 !! 2.0 ! 2007-12 (C. Ethe) 8 8 !!---------------------------------------------------------------------- 9 9 #if defined key_c14b … … 17 17 USE trc ! TOP variables 18 18 USE trcsms_c14b ! C14 sms trends 19 USE in_out_manager ! I/O manager20 19 21 20 IMPLICIT NONE … … 24 23 PUBLIC trc_ini_c14b ! called by trcini.F90 module 25 24 26 INTEGER :: & ! With respect to data file !! 27 jpybeg = 1765 , & !: starting year for C14 28 jpyend = 2002 !: ending year for C14 29 30 INTEGER :: & 31 nrec , & ! number of year in CO2 Concentrations file 32 nmaxrec 33 34 INTEGER :: inum1, inum2 ! unit number 35 36 REAL(wp) :: & 37 ys40 = -40. , & ! 40 degrees south 38 ys20 = -20. , & ! 20 degrees south 39 yn20 = 20. , & ! 20 degrees north 40 yn40 = 40. ! 40 degrees north 41 42 !!--------------------------------------------------------------------- 25 ! ! With respect to data file !! 26 INTEGER :: jpybeg = 1765 ! starting year for C14 27 INTEGER :: jpyend = 2002 ! ending year for C14 28 INTEGER :: nrec ! number of year in CO2 Concentrations file 29 INTEGER :: nmaxrec 30 INTEGER :: inum1, inum2 ! unit number 31 32 REAL(wp) :: ys40 = -40. ! 40 degrees south 33 REAL(wp) :: ys20 = -20. ! 20 degrees south 34 REAL(wp) :: yn20 = 20. ! 20 degrees north 35 REAL(wp) :: yn40 = 40. ! 40 degrees north 36 37 !!---------------------------------------------------------------------- 43 38 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 44 39 !! $Id$ 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 46 !!---------------------------------------------------------------------- 47 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 41 !!---------------------------------------------------------------------- 48 42 CONTAINS 49 43 … … 59 53 !!---------------------------------------------------------------------- 60 54 61 ! Control consitency 62 CALL trc_ctl_c14b 55 ! ! Allocate C14b arrays 56 IF( trc_sms_c14b_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trc_ini_c14b : unable to allocate C14b arrays' ) 57 58 CALL trc_ctl_c14b ! Control consitency 63 59 64 60 IF(lwp) WRITE(numout,*) '' … … 69 65 ! Initialization of boundaries conditions 70 66 ! --------------------------------------- 71 qtr_c14(:,:) = 0. e067 qtr_c14(:,:) = 0._wp 72 68 73 69 ! Initialization of qint in case of no restart … … 78 74 WRITE(numout,*) 'Initialization de qint ; No restart : qint equal zero ' 79 75 ENDIF 80 trn (:,:,:,jpc14) = 0. e081 qint_c14(:,: ) = 0. e076 trn (:,:,:,jpc14) = 0._wp 77 qint_c14(:,: ) = 0._wp 82 78 ENDIF 83 79 … … 156 152 fareaz(ji,jj,3) = 0. 157 153 ENDIF 158 END DO 159 END DO 160 154 END DO 155 END DO 161 156 ! 162 157 IF(lwp) WRITE(numout,*) 'Initialization of C14 bomb tracer done' 163 158 IF(lwp) WRITE(numout,*) ' ' 164 159 ! 165 160 END SUBROUTINE trc_ini_c14b 166 161 162 167 163 SUBROUTINE trc_ctl_c14b 168 164 !!---------------------------------------------------------------------- … … 179 175 ! Check number of tracers 180 176 ! ----------------------- 181 IF( jp_c14b > 1) CALL ctl_stop( ' Change jp_c14b to be equal 1 in par_c14b.F90' )177 IF( jp_c14b > 1) CALL ctl_stop( ' Change jp_c14b to be equal 1 in par_c14b.F90' ) 182 178 183 179 ! Check tracer names 184 180 ! ------------------ 185 IF 186 187 181 IF( ctrcnm(jpc14) /= 'C14B' ) THEN 182 ctrcnm(jpc14) = 'C14B' 183 ctrcnl(jpc14) = 'Bomb C14 concentration' 188 184 ENDIF 189 185 … … 197 193 ! ------------------ 198 194 IF( ctrcun(jpc14) /= 'ration' ) THEN 199 ctrcun(jpc14) = 'ration'195 ctrcun(jpc14) = 'ration' 200 196 IF(lwp) THEN 201 197 CALL ctl_warn( ' we force tracer unit' ) … … 206 202 ! 207 203 END SUBROUTINE trc_ctl_c14b 204 208 205 #else 209 206 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcnam_c14b.F90
r2567 r2715 16 16 USE trc ! TOP variables 17 17 USE trcsms_c14b ! C14b specific variable 18 USE in_out_manager ! I/O manager19 18 20 19 IMPLICIT NONE -
trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcrst_c14b.F90
r2528 r2715 17 17 USE trc ! TOP variables 18 18 USE trcsms_c14b ! c14b sms trends 19 USE in_out_manager ! I/O manager20 19 USE iom 21 20 -
trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
r2528 r2715 4 4 !! TOP : Bomb C14 main module 5 5 !!====================================================================== 6 !! History - ! 1994-05 ( J. Orr ) origi al code6 !! History - ! 1994-05 ( J. Orr ) original code 7 7 !! 1.0 ! 2006-02 ( J.M. Molines ) Free form + modularity 8 8 !! 2.0 ! 2008-12 ( C. Ethe ) reorganisation 9 !! 4.0 ! 2011-02 ( A.R. Porter, STFC Daresbury ) Dynamic memory 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_c14b … … 12 13 !! 'key_c14b' Bomb C14 tracer 13 14 !!---------------------------------------------------------------------- 14 !! trc_sms_c14b 15 !!---------------------------------------------------------------------- 16 USE oce_trc ! Ocean variables17 USE par_trc ! TOP parameters18 USE trc ! TOP variables15 !! trc_sms_c14b : compute and add C14 suface forcing to C14 trends 16 !!---------------------------------------------------------------------- 17 USE oce_trc ! Ocean variables 18 USE par_trc ! TOP parameters 19 USE trc ! TOP variables 19 20 USE trdmod_oce 20 21 USE trdmod_trc 21 USE iom 22 USE iom ! I/O library 22 23 23 24 IMPLICIT NONE 24 25 PRIVATE 25 26 26 !! * Routine accessibility 27 PUBLIC trc_sms_c14b ! called in ??? 28 29 !! * Module variables 27 PUBLIC trc_sms_c14b ! called in trcsms.F90 28 PUBLIC trc_sms_c14b_alloc ! called in trcini_c14b.F90 29 30 30 INTEGER , PUBLIC, PARAMETER :: jpmaxrec = 240 ! temporal parameter 31 31 INTEGER , PUBLIC, PARAMETER :: jpmaxrec2 = 2 * jpmaxrec ! … … 37 37 INTEGER , PUBLIC :: nyear_beg ! initial year (aa) 38 38 39 REAL(wp), PUBLIC, DIMENSION(jpmaxrec,jpzon) :: bomb!: C14 atm data (3 zones)40 REAL(wp), PUBLIC, DIMENSION(jpi,jpj ,jpzon) :: fareaz!: Spatial Interpolation Factors41 REAL(wp), PUBLIC, DIMENSION(jpmaxrec2) :: spco2!: Atmospheric CO239 REAL(wp), PUBLIC, DIMENSION(jpmaxrec,jpzon) :: bomb !: C14 atm data (3 zones) 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: fareaz !: Spatial Interpolation Factors 41 REAL(wp), PUBLIC, DIMENSION(jpmaxrec2) :: spco2 !: Atmospheric CO2 42 42 43 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: qtr_c14 !: flux at surface 44 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: qint_c14 !: cumulative flux 45 46 REAL(wp) :: xlambda, xdecay, xaccum ! C14 decay coef. 47 48 REAL(wp) :: xconv1 = 1.0 ! conversion from to 49 REAL(wp) :: xconv2 = 0.01/3600. ! conversion from cm/h to m/s: 50 REAL(wp) :: xconv3 = 1.0e+3 ! conversion from mol/l/atm to mol/m3/atm 51 52 !! * Substitutions 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qtr_c14 !: flux at surface 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qint_c14 !: cumulative flux 45 46 REAL(wp) :: xlambda, xdecay, xaccum ! C14 decay coef. 47 REAL(wp) :: xconv1 = 1._wp ! conversion from to 48 REAL(wp) :: xconv2 = 0.01_wp / 3600._wp ! conversion from cm/h to m/s: 49 REAL(wp) :: xconv3 = 1.e+3_wp ! conversion from mol/l/atm to mol/m3/atm 50 51 !! * Substitutions 53 52 # include "top_substitute.h90" 54 53 55 !!---------------------------------------------------------------------- 56 !! TOP 1.0 , LOCEAN-IPSL (2005) 57 !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcc14bomb.F90,v 1.2 2005/11/14 16:42:43 opalod Exp $ 58 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 59 !!---------------------------------------------------------------------- 60 54 !!---------------------------------------------------------------------- 55 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 56 !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcc14bomb.F90,v 1.2 2005/11/14 16:42:43 opalod Exp $ 57 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 58 !!---------------------------------------------------------------------- 61 59 CONTAINS 62 60 63 SUBROUTINE trc_sms_c14b( kt ) 64 !!---------------------------------------------------------------------- 65 !! *** ROUTINE trc_sms_c14b *** 66 !! 67 !! ** Purpose : Compute the surface boundary contition on C14bomb 68 !! passive tracer associated with air-mer fluxes and add it to 69 !! the general trend of tracers equations. 70 !! 71 !! ** Original comments from J. Orr : 72 !! 73 !! Calculates the input of Bomb C-14 to the surface layer of OPA 74 !! 75 !! James Orr, LMCE, 28 October 1992 76 !! 77 !! Initial approach mimics that of Toggweiler, Dixon, & Bryan (1989) 78 !! (hereafter referred to as TDB) with constant gas exchange, 79 !! although in this case, a perturbation approach is used for 80 !! bomb-C14 so that both the ocean and atmosphere begin at zero. 81 !! This saves tremendous amounts of computer time since no 82 !! equilibrum run is first required (i.e., for natural C-14). 83 !! Note: Many sensitivity tests can be run with this approach and 84 !! one never has to make a run for natural C-14; otherwise, 85 !! a run for natural C-14 must be run each time that one 86 !! changes a model parameter! 87 !! 88 !! 89 !! 19 August 1993: Modified to consider Atmospheric C-14 fom IPCC. 90 !! That is, the IPCC has provided a C-14 atmospheric record (courtesy 91 !! of Martin Heimann) for model calibration. This model spans from 92 !! preindustrial times to present, in a format different than that 93 !! given by TDB. It must be converted to the ORR C-14 units used 94 !! here, although in this case, the perturbation includes not only 95 !! bomb C-14 but changes due to the Suess effect. 96 !! 97 !!---------------------------------------------------------------------- 98 !! * Arguments 99 INTEGER, INTENT( in ) :: kt ! ocean time-step index 100 101 !! * Local declarations 102 INTEGER :: & 103 ji, jj, jk, jz 104 105 INTEGER :: & 106 iyear_beg, & 107 iyear_beg1, iyear_end1, & 108 imonth1, im1, im2, & 109 iyear_beg2, iyear_end2, & 110 imonth2, in1, in2 111 112 REAL(wp), DIMENSION(jpi,jpj) :: & 113 zatmbc14 114 115 REAL(wp), DIMENSION(jpzon) :: & 116 zonbc14 !: time interp atm C14 117 118 REAL(wp) :: & 119 zpco2at !: time interp atm C02 120 121 REAL(wp) :: & !: dummy variables 122 zt, ztp, zsk, & 123 zsol , & !: solubility 124 zsch , & !: schmidt number 125 zv2 , & !: wind speed ( square) 126 zpv , & !: piston velocity 127 zdemi, ztra 128 #if defined key_diatrc && defined key_iomput 129 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d 130 #endif 131 !!---------------------------------------------------------------------- 132 133 IF( kt == nit000 ) THEN 134 ! Computation of decay coeffcient 135 zdemi = 5730. 61 SUBROUTINE trc_sms_c14b( kt ) 62 !!---------------------------------------------------------------------- 63 !! *** ROUTINE trc_sms_c14b *** 64 !! 65 !! ** Purpose : Compute the surface boundary contition on C14bomb 66 !! passive tracer associated with air-mer fluxes and add it to 67 !! the general trend of tracers equations. 68 !! 69 !! ** Original comments from J. Orr : 70 !! 71 !! Calculates the input of Bomb C-14 to the surface layer of OPA 72 !! 73 !! James Orr, LMCE, 28 October 1992 74 !! 75 !! Initial approach mimics that of Toggweiler, Dixon, & Bryan (1989) 76 !! (hereafter referred to as TDB) with constant gas exchange, 77 !! although in this case, a perturbation approach is used for 78 !! bomb-C14 so that both the ocean and atmosphere begin at zero. 79 !! This saves tremendous amounts of computer time since no 80 !! equilibrum run is first required (i.e., for natural C-14). 81 !! Note: Many sensitivity tests can be run with this approach and 82 !! one never has to make a run for natural C-14; otherwise, 83 !! a run for natural C-14 must be run each time that one 84 !! changes a model parameter! 85 !! 86 !! 87 !! 19 August 1993: Modified to consider Atmospheric C-14 fom IPCC. 88 !! That is, the IPCC has provided a C-14 atmospheric record (courtesy 89 !! of Martin Heimann) for model calibration. This model spans from 90 !! preindustrial times to present, in a format different than that 91 !! given by TDB. It must be converted to the ORR C-14 units used 92 !! here, although in this case, the perturbation includes not only 93 !! bomb C-14 but changes due to the Suess effect. 94 !! 95 !!---------------------------------------------------------------------- 96 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 97 USE wrk_nemo, ONLY: zatmbc14 => wrk_2d_1 98 USE wrk_nemo, ONLY: zw3d => wrk_3d_1 99 ! 100 INTEGER, INTENT(in) :: kt ! ocean time-step index 101 ! 102 INTEGER :: ji, jj, jk, jz ! dummy loop indices 103 INTEGER :: iyear_beg , iyear_beg1, iyear_end1 104 INTEGER :: iyear_beg2, iyear_end2 105 INTEGER :: imonth1, im1, in1 106 INTEGER :: imonth2, im2, in2 107 REAL(wp), DIMENSION(jpzon) :: zonbc14 !: time interp atm C14 108 REAL(wp) :: zpco2at !: time interp atm C02 109 REAL(wp) :: zt, ztp, zsk ! dummy variables 110 REAL(wp) :: zsol ! solubility 111 REAL(wp) :: zsch ! schmidt number 112 REAL(wp) :: zv2 ! wind speed ( square) 113 REAL(wp) :: zpv ! piston velocity 114 REAL(wp) :: zdemi, ztra 115 !!---------------------------------------------------------------------- 116 117 IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1) ) THEN 118 CALL ctl_stop('trc_sms_c14b : requested workspace arrays unavailable') ; RETURN 119 ENDIF 120 121 IF( kt == nit000 ) THEN ! Computation of decay coeffcient 122 zdemi = 5730._wp 136 123 xlambda = LOG(2.) / zdemi / ( nyear_len(1) * rday ) 137 124 xdecay = EXP( - xlambda * rdt ) 138 xaccum = 1. 0- xdecay125 xaccum = 1._wp - xdecay 139 126 ENDIF 140 127 … … 206 193 ! (zonmean), computes area-weighted mean to give the atmospheric C-14 207 194 ! ---------------------------------------------------------------- 208 DO jj = 1, jpj 209 DO ji = 1, jpi 210 zatmbc14(ji,jj) = zonbc14(1) * fareaz(ji,jj,1) & 211 & + zonbc14(2) * fareaz(ji,jj,2) & 212 & + zonbc14(3) * fareaz(ji,jj,3) 213 END DO 214 END DO 195 zatmbc14(:,:) = zonbc14(1) * fareaz(:,:,1) & 196 & + zonbc14(2) * fareaz(:,:,2) & 197 & + zonbc14(3) * fareaz(:,:,3) 215 198 216 199 ! time interpolation of CO2 concentrations to it time step … … 218 201 & + spco2(iyear_end2) * FLOAT( in2 ) ) / 6. 219 202 220 IF 203 IF(lwp) THEN 221 204 WRITE(numout, *) 'time : ', kt, ' CO2 year begin/end :',iyear_beg2,'/',iyear_end2, & 222 205 & ' CO2 concen : ',zpco2at … … 238 221 zsol = EXP( -60.2409 + 93.4517 / ztp + 23.3585 * LOG( ztp ) + zsk * tsn(ji,jj,1,jp_sal) ) 239 222 ! convert solubilities [mol/(l * atm)] -> [mol/(m^3 * ppm)] 240 zsol = zsol * 1. 0e-03223 zsol = zsol * 1.e-03 241 224 ELSE 242 zsol = 0. 225 zsol = 0._wp 243 226 ENDIF 244 227 … … 307 290 CALL iom_put( "fdecay" , zw3d ) 308 291 #endif 309 IF( l_trdtrc ) THEN 310 CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt ) ! save trends 311 END IF 312 313 END SUBROUTINE trc_sms_c14b 292 IF( l_trdtrc ) CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt ) ! save trends 293 294 IF( wrk_not_released(2, 1) .OR. & 295 wrk_not_released(3, 1) ) CALL ctl_stop('trc_sms_c14b : failed to release workspace arrays') 296 ! 297 END SUBROUTINE trc_sms_c14b 298 299 300 INTEGER FUNCTION trc_sms_c14b_alloc() 301 !!---------------------------------------------------------------------- 302 !! *** ROUTINE trc_sms_c14b_alloc *** 303 !!---------------------------------------------------------------------- 304 ALLOCATE( fareaz (jpi,jpj ,jpzon) , & 305 & qtr_c14 (jpi,jpj) , & 306 & qint_c14(jpi,jpj) , STAT=trc_sms_c14b_alloc ) 307 ! 308 IF( trc_sms_c14b_alloc /= 0 ) CALL ctl_warn('trc_sms_c14b_alloc: failed to allocate arrays') 309 ! 310 END FUNCTION trc_sms_c14b_alloc 314 311 315 312 #else 316 317 318 313 !!---------------------------------------------------------------------- 314 !! Default option Dummy module 315 !!---------------------------------------------------------------------- 319 316 CONTAINS 320 SUBROUTINE trc_sms_c14b( kt ) ! Empty routine321 WRITE(*,*) 'trc_freons: You should not have seen this print! error?', kt322 END SUBROUTINE trc_sms_c14b317 SUBROUTINE trc_sms_c14b( kt ) ! Empty routine 318 WRITE(*,*) 'trc_freons: You should not have seen this print! error?', kt 319 END SUBROUTINE trc_sms_c14b 323 320 #endif 324 321 -
trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90
r2528 r2715 15 15 USE par_trc ! TOP parameters 16 16 USE trc ! TOP variables 17 USE trcsms_cfc ! CFC sms trends 18 USE in_out_manager ! I/O manager 17 USE trcsms_cfc ! CFC sms trends 19 18 20 19 IMPLICIT NONE … … 34 33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 35 34 !!---------------------------------------------------------------------- 36 37 35 CONTAINS 38 36 … … 45 43 !! ** Method : - Read the namcfc namelist and check the parameter values 46 44 !!---------------------------------------------------------------------- 47 INTEGER :: 48 REAL(wp) :: zyy ,zyd45 INTEGER :: ji, jj, jn, jl, jm, js 46 REAL(wp) :: zyy, zyd 49 47 !!---------------------------------------------------------------------- 50 48 … … 53 51 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 54 52 53 ! ! Allocate CFC arrays 54 IF( trc_sms_cfc_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trc_ini_cfc: unable to allocate CFC arrays' ) 55 55 56 56 57 ! Initialization of boundaries conditions 57 58 ! --------------------------------------- 58 xphem (:,:) = 0. e059 p_cfc(:,:,:) = 0. e059 xphem (:,:) = 0._wp 60 p_cfc(:,:,:) = 0._wp 60 61 61 62 ! Initialization of qint in case of no restart 62 63 !---------------------------------------------- 63 qtr_cfc(:,:,:) = 0. e064 qtr_cfc(:,:,:) = 0._wp 64 65 IF( .NOT. ln_rsttr ) THEN 65 66 IF(lwp) THEN … … 67 68 WRITE(numout,*) 'Initialization de qint ; No restart : qint equal zero ' 68 69 ENDIF 69 qint_cfc(:,:,:) = 0. e070 qint_cfc(:,:,:) = 0._wp 70 71 DO jl = 1, jp_cfc 71 72 jn = jp_cfc0 + jl - 1 72 trn (:,:,:,jn) = 0.e073 trn(:,:,:,jn) = 0._wp 73 74 END DO 74 75 ENDIF … … 116 117 WRITE(numout,*) ' Year p11HN p11HS p12HN p12HS ' 117 118 DO jn = 30, 100 118 WRITE(numout, '( 1I4, 4F9.2)') & 119 & jn, p_cfc(jn,1,1), p_cfc(jn,2,1), p_cfc(jn,1,2), p_cfc(jn,2,2) 119 WRITE(numout, '( 1I4, 4F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), p_cfc(jn,1,2), p_cfc(jn,2,2) 120 120 END DO 121 121 ENDIF … … 135 135 END DO 136 136 ! 137 138 137 IF(lwp) WRITE(numout,*) 'Initialization of CFC tracers done' 139 138 IF(lwp) WRITE(numout,*) ' ' 140 139 ! 141 140 END SUBROUTINE trc_ini_cfc 142 141 -
trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90
r2567 r2715 16 16 USE trc ! TOP variables 17 17 USE trcsms_cfc ! CFC specific variable 18 USE in_out_manager ! I/O manager19 18 20 19 IMPLICIT NONE -
trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcrst_cfc.F90
r2528 r2715 17 17 USE trc ! TOP variables 18 18 USE trcsms_cfc ! CFC sms trends 19 USE in_out_manager ! I/O manager20 19 USE iom 21 20 -
trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r2528 r2715 4 4 !! TOP : CFC main model 5 5 !!====================================================================== 6 !! History : -! 1999-10 (JC. Dutay) original code7 !! 1.0 ! 2004-03(C. Ethe) free form + modularity8 !! 6 !! History : OPA ! 1999-10 (JC. Dutay) original code 7 !! NEMO 1.0 ! 2004-03 (C. Ethe) free form + modularity 8 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) reorganisation 9 9 !!---------------------------------------------------------------------- 10 10 #if defined key_cfc … … 12 12 !! 'key_cfc' CFC tracers 13 13 !!---------------------------------------------------------------------- 14 !! trc_sms_cfc 15 !! trc_cfc_cst : sets constants for CFC surface forcing computation16 !!---------------------------------------------------------------------- 17 USE oce_trc ! Ocean variables18 USE par_trc ! TOP parameters19 USE trc ! TOP variables14 !! trc_sms_cfc : compute and add CFC suface forcing to CFC trends 15 !! trc_cfc_cst : sets constants for CFC surface forcing computation 16 !!---------------------------------------------------------------------- 17 USE oce_trc ! Ocean variables 18 USE par_trc ! TOP parameters 19 USE trc ! TOP variables 20 20 USE trdmod_oce 21 21 USE trdmod_trc 22 USE iom 22 USE iom ! I/O library 23 23 24 24 IMPLICIT NONE 25 25 PRIVATE 26 26 27 PUBLIC trc_sms_cfc ! called in ??? 27 PUBLIC trc_sms_cfc ! called in ??? 28 PUBLIC trc_sms_cfc_alloc ! called in trcini_cfc.F90 28 29 29 30 INTEGER , PUBLIC, PARAMETER :: jpyear = 150 ! temporal parameter … … 34 35 INTEGER , PUBLIC :: npyear ! Number of years read in CFC1112 file 35 36 36 REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, 2 ) :: p_cfc ! partial hemispheric pressure for CFC37 REAL(wp), PUBLIC, DIMENSION(jpi,jpj):: xphem ! spatial interpolation factor for patm38 REAL(wp), PUBLIC, DIMENSION(jpi,jpj ,jp_cfc) :: qtr_cfc ! flux at surface39 REAL(wp), PUBLIC, DIMENSION(jpi,jpj ,jp_cfc) :: qint_cfc ! cumulative flux37 REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, 2 ) :: p_cfc ! partial hemispheric pressure for CFC 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: xphem ! spatial interpolation factor for patm 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qtr_cfc ! flux at surface 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qint_cfc ! cumulative flux 40 41 41 42 REAL(wp), DIMENSION(4,2) :: soa ! coefficient for solubility of CFC [mol/l/atm] … … 54 55 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 55 56 !! $Id$ 56 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 57 !!---------------------------------------------------------------------- 58 57 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 58 !!---------------------------------------------------------------------- 59 59 CONTAINS 60 60 … … 75 75 !! CFC concentration in pico-mol/m3 76 76 !!---------------------------------------------------------------------- 77 INTEGER, INTENT( in ) :: kt ! ocean time-step index 78 !! 79 INTEGER :: ji, jj, jn, jl, jm, js 80 INTEGER :: iyear_beg, iyear_end 81 INTEGER :: im1, im2 82 77 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 78 USE wrk_nemo, ONLY: ztrcfc => wrk_3d_1 ! use for CFC sms trend 79 ! 80 INTEGER, INTENT(in) :: kt ! ocean time-step index 81 ! 82 INTEGER :: ji, jj, jn, jl, jm, js 83 INTEGER :: iyear_beg, iyear_end 84 INTEGER :: im1, im2 83 85 REAL(wp) :: ztap, zdtap 84 86 REAL(wp) :: zt1, zt2, zt3, zv2 … … 88 90 REAL(wp) :: zca_cfc ! concentration at equilibrium 89 91 REAL(wp) :: zak_cfc ! transfert coefficients 90 91 REAL(wp), DIMENSION(jphem,jp_cfc) :: zpatm ! atmospheric function 92 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrcfc ! use for CFC sms trend 93 !!---------------------------------------------------------------------- 92 REAL(wp), DIMENSION(jphem,jp_cfc) :: zpatm ! atmospheric function 93 !!---------------------------------------------------------------------- 94 ! 95 IF( wrk_in_use(3, 1) ) THEN 96 CALL ctl_stop('trc_sms_cfc: requested workspace array unavailable') ; RETURN 97 ENDIF 94 98 95 99 IF( kt == nit000 ) CALL trc_cfc_cst … … 175 179 #if defined key_diatrc 176 180 ! Save diagnostics , just for CFC11 177 # if ! defined key_iomput 181 # if defined key_iomput 182 CALL iom_put( "qtrCFC11" , qtr_cfc (:,:,1) ) 183 CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 184 # else 178 185 trc2d(:,:,jp_cfc0_2d ) = qtr_cfc (:,:,1) 179 186 trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 180 # else181 CALL iom_put( "qtrCFC11" , qtr_cfc (:,:,1) )182 CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) )183 187 # endif 184 188 #endif … … 190 194 END DO 191 195 END IF 192 196 ! 197 IF( wrk_not_released(3, 1) ) CALL ctl_stop('trc_sms_cfc: failed to release workspace array') 198 ! 193 199 END SUBROUTINE trc_sms_cfc 200 194 201 195 202 SUBROUTINE trc_cfc_cst … … 200 207 !!--------------------------------------------------------------------- 201 208 202 203 ! coefficient for CFC11 204 !---------------------- 205 206 ! Solubility 207 soa(1,1) = -229.9261 208 soa(2,1) = 319.6552 209 soa(3,1) = 119.4471 210 soa(4,1) = -1.39165 211 212 sob(1,1) = -0.142382 213 sob(2,1) = 0.091459 214 sob(3,1) = -0.0157274 215 216 ! Schmidt number 217 sca(1,1) = 3501.8 218 sca(2,1) = -210.31 219 sca(3,1) = 6.1851 220 sca(4,1) = -0.07513 221 222 ! coefficient for CFC12 223 !---------------------- 224 225 ! Solubility 226 soa(1,2) = -218.0971 227 soa(2,2) = 298.9702 228 soa(3,2) = 113.8049 229 soa(4,2) = -1.39165 230 231 sob(1,2) = -0.143566 232 sob(2,2) = 0.091015 233 sob(3,2) = -0.0153924 234 235 ! schmidt number 236 sca(1,2) = 3845.4 237 sca(2,2) = -228.95 238 sca(3,2) = 6.1908 239 sca(4,2) = -0.067430 209 ! coefficient for CFC11 210 !---------------------- 211 212 ! Solubility 213 soa(1,1) = -229.9261 214 soa(2,1) = 319.6552 215 soa(3,1) = 119.4471 216 soa(4,1) = -1.39165 217 218 sob(1,1) = -0.142382 219 sob(2,1) = 0.091459 220 sob(3,1) = -0.0157274 221 222 ! Schmidt number 223 sca(1,1) = 3501.8 224 sca(2,1) = -210.31 225 sca(3,1) = 6.1851 226 sca(4,1) = -0.07513 227 228 ! coefficient for CFC12 229 !---------------------- 230 231 ! Solubility 232 soa(1,2) = -218.0971 233 soa(2,2) = 298.9702 234 soa(3,2) = 113.8049 235 soa(4,2) = -1.39165 236 237 sob(1,2) = -0.143566 238 sob(2,2) = 0.091015 239 sob(3,2) = -0.0153924 240 241 ! schmidt number 242 sca(1,2) = 3845.4 243 sca(2,2) = -228.95 244 sca(3,2) = 6.1908 245 sca(4,2) = -0.067430 240 246 241 247 END SUBROUTINE trc_cfc_cst 242 248 249 250 INTEGER FUNCTION trc_sms_cfc_alloc() 251 !!---------------------------------------------------------------------- 252 !! *** ROUTINE trc_sms_cfc_alloc *** 253 !!---------------------------------------------------------------------- 254 ALLOCATE( xphem (jpi,jpj) , & 255 & qtr_cfc (jpi,jpj,jp_cfc) , & 256 & qint_cfc(jpi,jpj,jp_cfc) , STAT=trc_sms_cfc_alloc ) 257 ! 258 IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.') 259 ! 260 END FUNCTION trc_sms_cfc_alloc 261 243 262 #else 244 263 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/sms_lobster.F90
r2528 r2715 4 4 !! TOP : LOBSTER 1 Source Minus Sink variables 5 5 !!---------------------------------------------------------------------- 6 !! History : - ! 1999-09(M. Levy) original code7 !! - ! 2000-12(O. Aumont, E. Kestenare) add sediment8 !! 1.0 ! 2005-10(C. Ethe) F909 !! 1.0! 2005-03 (A-S Kremeur) add fphylab, fzoolab, fdetlab, fdbod10 !! 11 !! 6 !! History : OPA ! 1999-09 (M. Levy) original code 7 !! - ! 2000-12 (O. Aumont, E. Kestenare) add sediment 8 !! NEMO 1.0 ! 2005-10 (C. Ethe) F90 9 !! - ! 2005-03 (A-S Kremeur) add fphylab, fzoolab, fdetlab, fdbod 10 !! - ! 2005-06 (A-S Kremeur) add sedpocb, sedpocn, sedpoca 11 !! 2.0 ! 2007-04 (C. Deltel, G. Madec) Free form and modules 12 12 !!---------------------------------------------------------------------- 13 14 13 #if defined key_lobster 15 14 !!---------------------------------------------------------------------- 16 15 !! 'key_lobster' LOBSTER model 17 16 !!---------------------------------------------------------------------- 18 USE par_oce 19 USE par_trc 17 USE par_oce ! ocean parameters 18 USE par_trc ! passive tracer parameters 19 USE lib_mpp ! MPP library 20 20 21 21 IMPLICIT NONE 22 22 PUBLIC 23 23 24 !!---------------------------------------------------------------------- 25 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 26 !! $Id$ 27 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 28 !!---------------------------------------------------------------------- 24 PUBLIC sms_lobster_alloc ! called in trcini_lobster.F90 29 25 30 26 !! biological parameters … … 76 72 REAL(wp) :: fdbod !: zooplankton mortality fraction that goes to detritus 77 73 78 REAL(wp), DIMENSION(jpk,jp_lobster) :: remdmp !: depth dependant damping coefficient of passive tracers74 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: remdmp !: depth dependant damping coefficient of passive tracers 79 75 80 76 !! Optical parameters 81 77 !! ------------------ 82 REAL(wp) :: xkr0 83 REAL(wp) :: xkg0 84 REAL(wp) :: xkrp 85 REAL(wp) :: xkgp 86 REAL(wp) :: xlr 87 REAL(wp) :: xlg 88 REAL(wp) :: rpig 78 REAL(wp) :: xkr0 !: water coefficient absorption in red (NAMELIST) 79 REAL(wp) :: xkg0 !: water coefficient absorption in green (NAMELIST) 80 REAL(wp) :: xkrp !: pigment coefficient absorption in red (NAMELIST) 81 REAL(wp) :: xkgp !: pigment coefficient absorption in green (NAMELIST) 82 REAL(wp) :: xlr !: exposant for pigment absorption in red (NAMELIST) 83 REAL(wp) :: xlg !: exposant for pigment absorption in green (NAMELIST) 84 REAL(wp) :: rpig !: chla/chla+phea ratio (NAMELIST) 89 85 90 INTEGER , DIMENSION(jpi,jpj) :: neln!: number of levels in the euphotic layer91 REAL(wp), DIMENSION(jpi,jpj) :: xze!: euphotic layer depth92 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xpar!: par (photosynthetic available radiation)86 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: neln !: number of levels in the euphotic layer 87 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: xze !: euphotic layer depth 88 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xpar !: par (photosynthetic available radiation) 93 89 94 90 !! Sediment parameters … … 98 94 REAL(wp) :: areacot !: ??? 99 95 100 REAL(wp), DIMENSION(jpi,jpj) :: dminl!: fraction of sinking POC released in sediments101 REAL(wp), DIMENSION(jpi,jpj,jpk) :: dmin3!: fraction of sinking POC released at each level96 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: dminl !: fraction of sinking POC released in sediments 97 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dmin3 !: fraction of sinking POC released at each level 102 98 103 REAL(wp), DIMENSION(jpi,jpj) :: sedpocb!: mass of POC in sediments104 REAL(wp), DIMENSION(jpi,jpj) :: sedpocn!: mass of POC in sediments105 REAL(wp), DIMENSION(jpi,jpj) :: sedpoca!: mass of POC in sediments99 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sedpocb !: mass of POC in sediments 100 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sedpocn !: mass of POC in sediments 101 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sedpoca !: mass of POC in sediments 106 102 107 REAL(wp), DIMENSION(jpi,jpj) :: fbod !: rapid sinking particles 108 REAL(wp), DIMENSION(jpi,jpj) :: cmask !: ??? 103 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fbod !: rapid sinking particles 104 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: cmask !: ??? 105 106 !!---------------------------------------------------------------------- 107 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 108 !! $Id$ 109 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 110 !!---------------------------------------------------------------------- 111 CONTAINS 112 113 INTEGER FUNCTION sms_lobster_alloc() 114 !!---------------------------------------------------------------------- 115 !! *** ROUTINE sms_lobster_alloc *** 116 !!---------------------------------------------------------------------- 117 ! 118 ALLOCATE( & 119 !* Biological parameters 120 & remdmp(jpk,jp_lobster) , & 121 !* Optical parameters 122 & neln (jpi,jpj) , xze (jpi,jpj) , xpar(jpi,jpj,jpk) , & 123 !* Sediment parameters 124 & dminl (jpi,jpj) , dmin3 (jpi,jpj,jpk) , & 125 & sedpocb(jpi,jpj) , sedpocn(jpi,jpj) , sedpoca(jpi,jpj) , & 126 & fbod (jpi,jpj) , cmask (jpi,jpj) , STAT=sms_lobster_alloc ) 127 ! 128 IF( lk_mpp ) CALL mpp_sum ( sms_lobster_alloc ) 129 IF( sms_lobster_alloc /= 0 ) CALL ctl_warn('sms_lobster_alloc: failed to allocate arrays') 130 ! 131 END FUNCTION sms_lobster_alloc 109 132 110 133 #else -
trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90
r2528 r2715 60 60 !! for passive tracers are saved for futher diagnostics. 61 61 !!--------------------------------------------------------------------- 62 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 63 USE wrk_nemo, ONLY: wrk_3d_2, wrk_4d_1 64 !! 62 65 INTEGER, INTENT( in ) :: kt ! ocean time-step index 63 66 !! … … 75 78 #endif 76 79 #if defined key_diatrc && defined key_iomput 77 REAL(wp), DIMENSION(jpi,jpj,17):: zw2d78 REAL(wp), DIMENSION(jpi,jpj,jpk,3) :: zw3d80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw2d 81 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zw3d 79 82 #endif 80 83 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrbio 81 84 CHARACTER (len=25) :: charout 82 85 !!--------------------------------------------------------------------- 86 87 #if defined key_diatrc && defined key_iomput 88 IF( ( wrk_in_use(3, 2) ) .OR. ( wrk_in_use(4, 1) ) ) THEN 89 CALL ctl_stop('trc_bio : requested workspace arrays unavailable.') 90 RETURN 91 END IF 92 ! Set-up pointers into sub-arrays of workspaces 93 zw2d => wrk_3d_2(:,:,1:17) 94 zw3d => wrk_4d_1(:,:,:,1:3) 95 #endif 83 96 84 97 IF( kt == nit000 ) THEN … … 90 103 fbod(:,:) = 0.e0 91 104 #if defined key_diatrc && ! defined key_iomput 105 # if defined key_iomput 106 zw2d (:,:,:) = 0.e0 107 zw3d(:,:,:,:) = 0.e0 108 # else 92 109 DO jl = jp_lob0_2d, jp_lob1_2d 93 110 trc2d(:,:,jl) = 0.e0 94 111 END DO 95 #endif 96 #if defined key_diatrc && defined key_iomput 97 zw2d(:,:,:) = 0.e0 98 zw3d(:,:,:,:) = 0.e0 112 # endif 99 113 #endif 100 114 … … 485 499 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 486 500 ENDIF 487 501 ! 502 #if defined key_diatrc && defined key_iomput 503 IF( ( wrk_not_released(3, 2) ) .OR. ( wrk_not_released(4, 1) ) ) & 504 & CALL ctl_stop('trc_bio : failed to release workspace arrays.') 505 #endif 506 ! 488 507 END SUBROUTINE trc_bio 489 508 -
trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90
r2528 r2715 101 101 sedpoca(ji,jj) = ( zwork + dminl(ji,jj) * fbod(ji,jj) & 102 102 & - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt 103 zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1 t(ji,jj) *e2t(ji,jj)103 zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj) 104 104 END DO 105 105 END DO -
trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90
r2528 r2715 4 4 !! TOP : initialisation of the LOBSTER biological model 5 5 !!====================================================================== 6 !! History : -! 1999-09 (M. Levy) Original code6 !! History : OPA ! 1999-09 (M. Levy) Original code 7 7 !! - ! 2000-12 (0. Aumont, E. Kestenare) add sediment 8 !! 8 !! NEMO 1.0 ! 2004-03 (C. Ethe) Modularity 9 9 !! - ! 2005-03 (O. Aumont, A. El Moussaoui) F90 10 10 !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) from trcini.lobster1.h90 … … 21 21 USE trc 22 22 USE lbclnk 23 USE lib_mpp24 USE lib_fortran25 23 26 24 IMPLICIT NONE … … 33 31 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 34 32 !! $Id$ 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 !!---------------------------------------------------------------------- 37 33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 34 !!---------------------------------------------------------------------- 38 35 CONTAINS 39 36 … … 43 40 !! ** purpose : specific initialisation for LOBSTER bio-model 44 41 !!---------------------------------------------------------------------- 42 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 43 USE wrk_nemo, ONLY: zrro => wrk_2d_1 , zdm0 => wrk_3d_1 44 !! 45 45 INTEGER :: ji, jj, jk, jn 46 46 REAL(wp) :: ztest, zfluo, zfluu 47 REAL(wp), DIMENSION(jpi,jpj) :: zrro48 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdm049 47 !!---------------------------------------------------------------------- 50 51 ! Control consitency52 CALL trc_ctl_lobster53 48 ! 49 IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1) ) THEN 50 CALL ctl_stop('trc_ini_lobster: requested workspace arrays unavailable') ; RETURN 51 ENDIF 54 52 55 53 IF(lwp) WRITE(numout,*) … … 57 55 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~' 58 56 57 ! ! Allocate LOBSTER arrays 58 IF( sms_lobster_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trc_ini_lobster: unable to allocate LOBSTER arrays' ) 59 60 61 59 62 ! initialization of fields for optical model 60 63 ! -------------------------------------------- 61 xze (:,:) = 5. e062 xpar(:,:,:) = 0. e064 xze (:,:) = 5._wp 65 xpar(:,:,:) = 0._wp 63 66 64 67 ! initialization for passive tracer remineralisation-damping array … … 70 73 71 74 IF(lwp) THEN 72 WRITE(numout,*) ' ' 73 WRITE(numout,*) ' trcini: compute remineralisation-damping ' 74 WRITE(numout,*) ' arrays for tracers' 75 WRITE(numout,*) 76 WRITE(numout,*) ' trcini: compute remineralisation-damping arrays for tracers' 75 77 ENDIF 76 78 … … 82 84 ! ------------------------------------------------------------ 83 85 84 zdm0 = 0.e085 zrro = 1. e086 DO jk = jpkb, jpkm187 DO jj = 1, jpj88 DO ji = 1, jpi86 zdm0 = 0._wp 87 zrro = 1._wp 88 DO jk = jpkb, jpkm1 89 DO jj = 1, jpj 90 DO ji = 1, jpi 89 91 zfluo = ( fsdepw(ji,jj,jk ) / fsdepw(ji,jj,jpkb) )**xhr 90 92 zfluu = ( fsdepw(ji,jj,jk+1) / fsdepw(ji,jj,jpkb) )**xhr 91 IF( zfluo.GT.1. ) zfluo = 1. e093 IF( zfluo.GT.1. ) zfluo = 1._wp 92 94 zdm0(ji,jj,jk) = zfluo - zfluu 93 IF( jk <= jpkb-1 ) zdm0(ji,jj,jk) = 0. e095 IF( jk <= jpkb-1 ) zdm0(ji,jj,jk) = 0._wp 94 96 zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk) 95 97 END DO 96 98 END DO 97 99 END DO 98 100 ! 99 101 zdm0(:,:,jpk) = zrro(:,:) 100 102 … … 103 105 ! contains total fraction, which has passed to the upper layers) 104 106 ! ---------------------------------------------------------------------- 105 dminl = 0.106 dmin3 = zdm0107 dminl(:,:) = 0._wp 108 dmin3(:,:,:) = zdm0 107 109 DO jk = 1, jpk 108 110 DO jj = 1, jpj 109 111 DO ji = 1, jpi 110 IF( tmask(ji,jj,jk) == 0. ) THEN112 IF( tmask(ji,jj,jk) == 0._wp ) THEN 111 113 dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) 112 dmin3(ji,jj,jk) = 0. e0114 dmin3(ji,jj,jk) = 0._wp 113 115 ENDIF 114 116 END DO … … 118 120 DO jj = 1, jpj 119 121 DO ji = 1, jpi 120 IF( tmask(ji,jj,1) == 0 ) dmin3(ji,jj,1) = 0. e0122 IF( tmask(ji,jj,1) == 0 ) dmin3(ji,jj,1) = 0._wp 121 123 END DO 122 124 END DO … … 124 126 ! Coastal mask 125 127 ! ------------ 126 cmask(:,:) = 0. e0128 cmask(:,:) = 0._wp 127 129 DO ji = 2, jpi-1 128 130 DO jj = 2, jpj-1 129 if (tmask(ji,jj,1) == 1) then131 IF( tmask(ji,jj,1) == 1._wp ) THEN 130 132 ztest=tmask(ji+1,jj,1)*tmask(ji-1,jj,1)*tmask(ji,jj+1,1)*tmask(ji,jj-1,1) 131 IF (ztest == 0) cmask(ji,jj) = 1.132 endif133 IF( ztest == 0 ) cmask(ji,jj) = 1._wp 134 ENDIF 133 135 END DO 134 136 END DO … … 138 140 ! Coastal surface 139 141 ! --------------- 140 areacot = glob_sum( e1 t(:,:) *e2t(:,:) * cmask(:,:) )142 areacot = glob_sum( e1e2t(:,:) * cmask(:,:) ) 141 143 142 144 ! Initialization of tracer concentration in case of no restart … … 220 222 trn(:,:,30,jp_lob_no3) = 20.01 * tmask(:,:,30) 221 223 222 # elif defined key_gyre 224 225 # elif defined key_gyre || defined key_orca_r2 223 226 ! LOBSTER initialisation for GYRE 224 227 ! ---------------------- … … 245 248 246 249 ! initialize the POC in sediments 247 sedpocb(:,:) = 0.e0 248 sedpocn(:,:) = 0.e0 249 sedpoca(:,:) = 0.e0 250 251 250 sedpocb(:,:) = 0._wp 251 sedpocn(:,:) = 0._wp 252 sedpoca(:,:) = 0._wp 253 ! 252 254 IF(lwp) WRITE(numout,*) 'Initialization of LOBSTER tracers done' 253 IF(lwp) WRITE(numout,*) ' ' 254 255 255 ! 256 IF( wrk_not_released(2, 1) .OR. & 257 wrk_not_released(3, 1) ) CALL ctl_stop('trc_ini_lobster: failed to release workspace arrays') 258 ! 256 259 END SUBROUTINE trc_ini_lobster 257 258 SUBROUTINE trc_ctl_lobster259 !!----------------------------------------------------------------------260 !! *** ROUTINE trc_ctl_lobster ***261 !!262 !! ** Purpose : control the cpp options, namelist and files263 !!----------------------------------------------------------------------264 INTEGER :: jl, jn265 266 IF(lwp) WRITE(numout,*)267 IF(lwp) WRITE(numout,*) ' use LOBSTER biological model '268 269 ! Check number of tracers270 ! -----------------------271 IF( jp_lobster /= 6 ) CALL ctl_stop( ' LOBSTER has 6 passive tracers. Change jp_lobster in par_lobster.F90' )272 273 ! Check tracer names274 ! ------------------275 IF( ctrcnm(jp_lob_det) /= 'DET' .OR. ctrcnm(jp_lob_zoo) /= 'ZOO' .OR. &276 & ctrcnm(jp_lob_phy) /= 'PHY' .OR. ctrcnm(jp_lob_no3) /= 'NO3' .OR. &277 & ctrcnm(jp_lob_nh4) /= 'NH4' .OR. ctrcnm(jp_lob_dom) /= 'DOM' .OR. &278 & ctrcnl(jp_lob_det) /= 'Detritus' .OR. &279 & ctrcnl(jp_lob_zoo) /= 'Zooplankton concentration' .OR. &280 & ctrcnl(jp_lob_phy) /= 'Phytoplankton concentration' .OR. &281 & ctrcnl(jp_lob_no3) /= 'Nitrate concentration' .OR. &282 & ctrcnl(jp_lob_nh4) /= 'Ammonium concentration' .OR. &283 & ctrcnl(jp_lob_dom) /= 'Dissolved organic matter' ) THEN284 ctrcnm(jp_lob_det)='DET'285 ctrcnl(jp_lob_det)='Detritus'286 ctrcnm(jp_lob_zoo)='ZOO'287 ctrcnl(jp_lob_zoo)='Zooplankton concentration'288 ctrcnm(jp_lob_phy)='PHY'289 ctrcnl(jp_lob_phy)='Phytoplankton concentration'290 ctrcnm(jp_lob_no3)='NO3'291 ctrcnl(jp_lob_no3)='Nitrate concentration'292 ctrcnm(jp_lob_nh4)='NH4'293 ctrcnl(jp_lob_nh4)='Ammonium concentration'294 ctrcnm(jp_lob_dom)='DOM'295 ctrcnl(jp_lob_dom)='Dissolved organic matter'296 IF(lwp) THEN297 CALL ctl_warn( ' We force tracer names ' )298 DO jl = 1, jp_lobster299 jn = jp_lob0 + jl - 1300 WRITE(numout,*) ' tracer nb: ',jn,' name = ',ctrcnm(jn), ctrcnl(jn)301 END DO302 WRITE(numout,*) ' '303 ENDIF304 ENDIF305 306 ! Check tracer units307 DO jl = 1, jp_lobster308 jn = jp_lob0 + jl - 1309 IF( ctrcun(jn) /= 'mmole-N/m3') THEN310 ctrcun(jn) = 'mmole-N/m3'311 IF(lwp) THEN312 CALL ctl_warn( ' We force tracer units ' )313 WRITE(numout,*) ' tracer ',ctrcnm(jn), 'UNIT= ',ctrcun(jn)314 ENDIF315 ENDIF316 END DO317 318 END SUBROUTINE trc_ctl_lobster319 260 320 261 #else -
trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcnam_lobster.F90
r2567 r2715 10 10 !! 'key_lobster' : LOBSTER bio-model 11 11 !!---------------------------------------------------------------------- 12 !! trc_nam_lobster : LOBSTER model namelist read 13 !!---------------------------------------------------------------------- 14 USE oce_trc ! Ocean variables 15 USE par_trc ! TOP parameters 16 USE trc ! TOP variables 17 USE sms_lobster ! sms trends 18 USE in_out_manager ! I/O manager 12 !! trc_nam_lobster : LOBSTER model namelist read 13 !!---------------------------------------------------------------------- 14 USE oce_trc ! Ocean variables 15 USE par_trc ! TOP parameters 16 USE trc ! TOP variables 17 USE sms_lobster ! sms trends 19 18 20 19 IMPLICIT NONE -
trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcopt.F90
r2528 r2715 52 52 !! xze ??? 53 53 !!--------------------------------------------------------------------- 54 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 55 USE wrk_nemo, ONLY: zpar100 => wrk_2d_1, & ! irradiance at euphotic layer depth 56 zpar0m => wrk_2d_2 ! irradiance just below the surface 57 USE wrk_nemo, ONLY: zparr => wrk_3d_2, & ! red and green compound of par 58 zparg => wrk_3d_3 59 !! 54 60 INTEGER, INTENT( in ) :: kt ! index of the time stepping 55 61 !! … … 59 65 REAL(wp) :: zkr, zkg ! total absorption coefficient in red and green 60 66 REAL(wp) :: zcoef ! temporary scalar 61 REAL(wp), DIMENSION(jpi,jpj) :: zpar100 ! irradiance at euphotic layer depth62 REAL(wp), DIMENSION(jpi,jpj) :: zpar0m ! irradiance just below the surface63 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zparr, zparg ! red and green compound of par64 67 65 68 !!--------------------------------------------------------------------- 69 70 IF( ( wrk_in_use(2, 1,2)) .OR. ( wrk_in_use(3, 2,3)) )THEN 71 CALL ctl_stop('trc_opt : requested workspace arrays unavailable') ; RETURN 72 END IF 66 73 67 74 IF( kt == nit000 ) THEN … … 130 137 ENDIF 131 138 ! 139 IF( wrk_not_released(2, 1,2) .OR. wrk_not_released(3, 2,3) ) & 140 CALL ctl_stop('trc_opt : failed to release workspace arrays') 141 ! 132 142 END SUBROUTINE trc_opt 133 143 -
trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcrst_lobster.F90
r2528 r2715 18 18 USE trcsms_lobster ! lobster sms trends 19 19 USE sms_lobster ! lobster sms trends 20 USE in_out_manager ! I/O manager21 20 USE iom 22 21 -
trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90
r2528 r2715 56 56 !! trend of passive tracers is saved for futher diagnostics. 57 57 !!--------------------------------------------------------------------- 58 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 59 USE wrk_nemo, ONLY: zwork => wrk_3d_2 60 USE wrk_nemo, ONLY: zw2d => wrk_2d_1 ! only used (if defined 61 ! key_diatrc && defined key_iomput) 62 !! 58 63 INTEGER, INTENT( in ) :: kt ! ocean time-step index 59 64 !! 60 65 INTEGER :: ji, jj, jk, jl 61 66 REAL(wp) :: ztra 62 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork63 #if defined key_diatrc && defined key_iomput64 REAL(wp), DIMENSION(jpi,jpj) :: zw2d65 #endif66 67 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrbio 67 68 CHARACTER (len=25) :: charout 68 69 !!--------------------------------------------------------------------- 70 71 IF( ( wrk_in_use(3,2)) .OR. ( wrk_in_use(2,1)) ) THEN 72 CALL ctl_stop('trc_sed : requested workspace arrays unavailable.') 73 RETURN 74 END IF 69 75 70 76 IF( kt == nit000 ) THEN … … 144 150 ENDIF 145 151 152 IF( ( wrk_not_released(3, 2) ) .OR. ( wrk_not_released(2, 1) ) ) & 153 & CALL ctl_stop('trc_sed : failed to release workspace arrays.') 154 146 155 END SUBROUTINE trc_sed 147 156 -
trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsms_lobster.F90
r2528 r2715 13 13 !! trcsms_lobster : Time loop of passive tracers sms 14 14 !!---------------------------------------------------------------------- 15 USE oce_trc !15 USE oce_trc ! 16 16 USE trc 17 17 USE trcbio … … 32 32 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 33 33 !! $Id$ 34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 35 35 !!---------------------------------------------------------------------- 36 37 36 CONTAINS 38 37 … … 45 44 !! 46 45 !! ** Method : - ??? 47 !! ------------------------------------------------------------------------------------- 46 !! -------------------------------------------------------------------- 47 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 48 USE wrk_nemo, ONLY: ztrlob => wrk_3d_1 ! used for lobster sms trends 49 !! 48 50 INTEGER, INTENT( in ) :: kt ! ocean time-step index 49 51 INTEGER :: jn 50 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrlob ! used for lobster sms trends 51 !! 52 !! -------------------------------------------------------------------- 53 54 IF( wrk_in_use(3, 1) ) THEN 55 CALL ctl_stop('trc_sms_lobster : requested workspace array unavailable') ; RETURN 56 ENDIF 52 57 53 58 CALL trc_opt( kt ) ! optical model … … 65 70 IF( lk_trdmld_trc ) CALL trd_mld_bio( kt ) ! trends: Mixed-layer 66 71 72 IF( wrk_not_released(3, 1) ) CALL ctl_stop('trc_sms_lobster : failed to release workspace array.') 73 ! 67 74 END SUBROUTINE trc_sms_lobster 68 75 -
trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90
r2528 r2715 24 24 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 25 25 !! $Id$ 26 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)26 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 27 27 !!---------------------------------------------------------------------- 28 29 28 CONTAINS 30 29 … … 38 37 !!---------------------------------------------------------------------- 39 38 40 ! Control consitency 41 CALL trc_ctl_my_trc 39 ! ! Allocate MY_TRC arrays 40 IF( sms_lobster_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trc_ini_my_trc: unable to allocate MY_TRC arrays' ) 41 42 CALL trc_ctl_my_trc ! Control consitency 42 43 43 44 IF(lwp) WRITE(numout,*) … … 46 47 47 48 IF( .NOT. ln_rsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 0. 48 49 49 ! 50 50 END SUBROUTINE trc_ini_my_trc 51 51 52 52 53 SUBROUTINE trc_ctl_my_trc 53 54 !!---------------------------------------------------------------------- … … 56 57 !! ** Purpose : control the cpp options, namelist and files 57 58 !!---------------------------------------------------------------------- 58 59 59 INTEGER :: jl, jn 60 60 !!---------------------------------------------------------------------- 61 ! 61 62 IF(lwp) WRITE(numout,*) 62 63 IF(lwp) WRITE(numout,*) ' use COLOR tracer ' 63 64 ! 64 65 DO jl = 1, jp_my_trc 65 66 jn = jp_myt0 + jl - 1 66 WRITE( ctrcnm(jn),'(a,i2.2)') 'CLR',jn67 WRITE( ctrcnm(jn),'(a,i2.2)' ) 'CLR', jn 67 68 ctrcnl(jn)='Color concentration' 68 69 ctrcun(jn)='N/A' 69 70 END DO 70 71 71 ! 72 72 END SUBROUTINE trc_ctl_my_trc 73 73 -
trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
r2528 r2715 10 10 !! 'key_my_trc' CFC tracers 11 11 !!---------------------------------------------------------------------- 12 !! trc_sms_my_trc : MY_TRC model main routine 12 !! trc_sms_my_trc : MY_TRC model main routine 13 !! trc_sms_my_trc_alloc : allocate arrays specific to MY_TRC sms 13 14 !!---------------------------------------------------------------------- 14 15 USE par_trc ! TOP parameters … … 21 22 PRIVATE 22 23 23 PUBLIC trc_sms_my_trc ! called by trcsms.F90 module 24 PUBLIC trc_sms_my_trc ! called by trcsms.F90 module 25 PUBLIC trc_sms_my_trc_alloc ! called by trcini_my_trc.F90 module 24 26 27 ! Defined HERE the arrays specific to MY_TRC sms and ALLOCATE them in trc_sms_my_trc_alloc 28 25 29 !!---------------------------------------------------------------------- 26 30 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 27 31 !! $Id$ 28 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)32 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 29 33 !!---------------------------------------------------------------------- 30 31 34 CONTAINS 32 35 … … 39 42 !! ** Method : - 40 43 !!---------------------------------------------------------------------- 41 INTEGER, INTENT(in) :: kt ! ocean time-step index 42 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrmyt 43 INTEGER :: jn 44 44 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 45 USE wrk_nemo, ONLY: ztrmyt => wrk_3d_1 ! used for lobster sms trends 46 ! 47 INTEGER, INTENT(in) :: kt ! ocean time-step index 48 INTEGER :: jn ! dummy loop index 49 !!---------------------------------------------------------------------- 45 50 46 51 IF(lwp) WRITE(numout,*) … … 49 54 50 55 WHERE( (glamt <= 170) .AND. (glamt >= 160) .AND. (gphit <= -74) .AND. (gphit >=-75.6) ) 51 trn(:,:,1,jpmyt1) = 1. 52 trb(:,:,1,jpmyt1) = 1. 53 tra(:,:,1,jpmyt1) = 0. 56 trn(:,:,1,jpmyt1) = 1._wp 57 trb(:,:,1,jpmyt1) = 1._wp 58 tra(:,:,1,jpmyt1) = 0._wp 54 59 END WHERE 55 60 56 61 WHERE( ((glamt <= -165) .OR. (glamt >= 160)) .AND. (gphit <= -76) .AND. (gphit >=-80)) 57 trn(:,:,1,jpmyt2) = 1. 58 trb(:,:,1,jpmyt2) = 1. 59 tra(:,:,1,jpmyt2) = 0. 62 trn(:,:,1,jpmyt2) = 1._wp 63 trb(:,:,1,jpmyt2) = 1._wp 64 tra(:,:,1,jpmyt2) = 0._wp 60 65 END WHERE 61 66 62 ! Save the trends in the ixed layer 63 IF( l_trdtrc ) THEN 67 IF( l_trdtrc ) THEN ! Save the trends in the ixed layer 64 68 DO jn = jp_myt0, jp_myt1 65 69 ztrmyt(:,:,:) = tra(:,:,:,jn) … … 69 73 ! 70 74 END SUBROUTINE trc_sms_my_trc 71 75 76 77 INTEGER FUNCTION trc_sms_my_trc_alloc() 78 !!---------------------------------------------------------------------- 79 !! *** ROUTINE trc_sms_my_trc_alloc *** 80 !!---------------------------------------------------------------------- 81 ! 82 ! ALLOCATE here the arrays specific to MY_TRC 83 ! ALLOCATE( tab(...) , STAT=trc_sms_my_trc_alloc ) 84 trc_sms_my_trc_alloc = 0 ! set to zero if no array to be allocated 85 ! 86 IF( trc_sms_my_trc_alloc /= 0 ) CALL ctl_warn('trc_sms_my_trc_alloc : failed to allocate arrays') 87 ! 88 END FUNCTION trc_sms_my_trc_alloc 89 90 72 91 #else 73 92 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zbio.F90
r2528 r2715 32 32 33 33 PUBLIC p4z_bio 34 35 !! * Shared module variables36 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !:37 xnegtr ! Array used to indicate negative tracer values38 39 34 40 35 !!* Substitution -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90
r2528 r2715 4 4 !! TOP : PISCES Sea water chemistry computed following OCMIP protocol 5 5 !!====================================================================== 6 !! History : -! 1988 (E. Maier-Reimer) Original code6 !! History : OPA ! 1988 (E. Maier-Reimer) Original code 7 7 !! - ! 1998 (O. Aumont) addition 8 8 !! - ! 1999 (C. Le Quere) modification 9 !! 9 !! NEMO 1.0 ! 2004 (O. Aumont) modification 10 10 !! - ! 2006 (R. Gangsto) modification 11 11 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 … … 15 15 !! 'key_pisces' PISCES bio-model 16 16 !!---------------------------------------------------------------------- 17 !! p4z_che : Sea water chemistry computed following OCMIP protocol 18 !!---------------------------------------------------------------------- 19 USE oce_trc ! 20 USE trc ! 21 USE sms_pisces ! 17 !! p4z_che : Sea water chemistry computed following OCMIP protocol 18 !!---------------------------------------------------------------------- 19 USE oce_trc ! 20 USE trc ! 21 USE sms_pisces ! 22 USE lib_mpp ! MPP library 22 23 23 24 IMPLICIT NONE 24 25 PRIVATE 25 26 26 PUBLIC p4z_che 27 28 !! * Shared module variables 29 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 30 sio3eq, fekeq !: chemistry of Fe and Si 31 32 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2) :: & !: 33 chemc !: Solubilities of O2 and CO2 34 35 !! * Module variables 36 37 REAL(wp) :: & 38 salchl = 1./1.80655 ! conversion factor for salinity --> chlorinity (Wooster et al. 1969) 39 40 REAL(wp) :: & ! coeff. for apparent solubility equilibrium 41 akcc1 = -171.9065 , & ! Millero et al. 1995 from Mucci 1983 42 akcc2 = -0.077993 , & 43 akcc3 = 2839.319 , & 44 akcc4 = 71.595 , & 45 akcc5 = -0.77712 , & 46 akcc6 = 0.0028426 , & 47 akcc7 = 178.34 , & 48 akcc8 = -0.07711 , & 49 akcc9 = 0.0041249 50 51 REAL(wp) :: & ! universal gas constants 52 rgas = 83.143, & 53 oxyco = 1./22.4144 54 55 REAL(wp) :: & ! borat constants 56 bor1 = 0.00023, & 57 bor2 = 1./10.82 58 59 REAL(wp) :: & ! 60 ca0 = -162.8301 , & 61 ca1 = 218.2968 , & 62 ca2 = 90.9241 , & 63 ca3 = -1.47696 , & 64 ca4 = 0.025695 , & 65 ca5 = -0.025225 , & 66 ca6 = 0.0049867 67 68 REAL(wp) :: & ! coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970) 69 c10 = -3670.7 , & 70 c11 = 62.008 , & 71 c12 = -9.7944 , & 72 c13 = 0.0118 , & 73 c14 = -0.000116 27 PUBLIC p4z_che ! 28 PUBLIC p4z_che_alloc ! 29 30 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sio3eq ! chemistry of Si 31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: fekeq ! chemistry of Fe 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: chemc ! Solubilities of O2 and CO2 33 34 REAL(wp) :: salchl = 1._wp / 1.80655_wp ! conversion factor for salinity --> chlorinity (Wooster et al. 1969) 35 36 REAL(wp) :: akcc1 = -171.9065_wp ! coeff. for apparent solubility equilibrium 37 REAL(wp) :: akcc2 = -0.077993_wp ! Millero et al. 1995 from Mucci 1983 38 REAL(wp) :: akcc3 = 2839.319_wp ! 39 REAL(wp) :: akcc4 = 71.595_wp ! 40 REAL(wp) :: akcc5 = -0.77712_wp ! 41 REAL(wp) :: akcc6 = 0.0028426_wp ! 42 REAL(wp) :: akcc7 = 178.34_wp ! 43 REAL(wp) :: akcc8 = -0.07711_wp ! 44 REAL(wp) :: akcc9 = 0.0041249_wp ! 45 46 REAL(wp) :: rgas = 83.143_wp ! universal gas constants 47 REAL(wp) :: oxyco = 1._wp / 22.4144_wp 48 49 REAL(wp) :: bor1 = 0.00023_wp ! borat constants 50 REAL(wp) :: bor2 = 1._wp / 10.82_wp 51 52 REAL(wp) :: ca0 = -162.8301_wp 53 REAL(wp) :: ca1 = 218.2968_wp 54 REAL(wp) :: ca2 = 90.9241_wp 55 REAL(wp) :: ca3 = -1.47696_wp 56 REAL(wp) :: ca4 = 0.025695_wp 57 REAL(wp) :: ca5 = -0.025225_wp 58 REAL(wp) :: ca6 = 0.0049867_wp 59 60 REAL(wp) :: c10 = -3670.7_wp ! coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970) 61 REAL(wp) :: c11 = 62.008_wp 62 REAL(wp) :: c12 = -9.7944_wp 63 REAL(wp) :: c13 = 0.0118_wp 64 REAL(wp) :: c14 = -0.000116_wp 74 65 75 66 REAL(wp) :: & ! coeff. for 2. dissoc. of carbonic acid (Millero, 1995) … … 133 124 ox2 = 23.8439 , & 134 125 ox3 = -0.034892 , & 135 ox4 = 0.015568, &126 ox4 = 0.015568 , & 136 127 ox5 = -0.0019387 137 128 … … 151 142 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 152 143 !! $Id$ 153 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 154 !!---------------------------------------------------------------------- 155 144 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 145 !!---------------------------------------------------------------------- 156 146 CONTAINS 157 147 … … 179 169 !CDIR NOVERRCHK 180 170 DO ji = 1, jpi 181 182 171 ! ! SET ABSOLUTE TEMPERATURE 183 172 ztkel = tsn(ji,jj,1,jp_tem) + 273.16 … … 324 313 END SUBROUTINE p4z_che 325 314 315 316 INTEGER FUNCTION p4z_che_alloc() 317 !!---------------------------------------------------------------------- 318 !! *** ROUTINE p4z_che_alloc *** 319 !!---------------------------------------------------------------------- 320 ALLOCATE( sio3eq(jpi,jpj,jpk) , fekeq(jpi,jpj,jpk) , chemc (jpi,jpj,2), STAT=p4z_che_alloc ) 321 ! 322 IF( p4z_che_alloc /= 0 ) CALL ctl_warn('p4z_che_alloc : failed to allocate arrays.') 323 ! 324 END FUNCTION p4z_che_alloc 325 326 326 #else 327 327 !!====================================================================== … … 330 330 CONTAINS 331 331 SUBROUTINE p4z_che( kt ) ! Empty routine 332 INTEGER, INTENT( in) :: kt332 INTEGER, INTENT(in) :: kt 333 333 WRITE(*,*) 'p4z_che: You should not have seen this print! error?', kt 334 334 END SUBROUTINE p4z_che -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90
r2528 r2715 27 27 USE sbc_oce , ONLY : atm_co2 28 28 #endif 29 USE lib_mpp30 USE lib_fortran31 29 32 30 IMPLICIT NONE … … 35 33 PUBLIC p4z_flx 36 34 PUBLIC p4z_flx_init 37 38 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: oce_co2 !: ocean carbon flux 39 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: satmco2 !: atmospheric pco2 40 REAL(wp) :: t_oce_co2_flx !: Total ocean carbon flux 41 REAL(wp) :: t_atm_co2_flx !: global mean of atmospheric pco2 42 REAL(wp) :: area !: ocean surface 43 REAL(wp) :: atcco2 = 278. !: pre-industrial atmospheric [co2] (ppm) 44 REAL(wp) :: atcox = 0.20946 !: 45 REAL(wp) :: xconv = 0.01/3600 !: coefficients for conversion 35 PUBLIC p4z_flx_alloc 36 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: oce_co2 !: ocean carbon flux 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: satmco2 !: atmospheric pco2 39 40 REAL(wp) :: t_oce_co2_flx !: Total ocean carbon flux 41 REAL(wp) :: t_atm_co2_flx !: global mean of atmospheric pco2 42 REAL(wp) :: area !: ocean surface 43 REAL(wp) :: atcco2 = 278._wp !: pre-industrial atmospheric [co2] (ppm) 44 REAL(wp) :: atcox = 0.20946_wp !: 45 REAL(wp) :: xconv = 0.01_wp / 3600._wp !: coefficients for conversion 46 46 47 47 !!* Substitution … … 50 50 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 51 51 !! $Id$ 52 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 53 !!---------------------------------------------------------------------- 54 52 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 53 !!---------------------------------------------------------------------- 55 54 CONTAINS 56 55 … … 63 62 !! ** Method : - ??? 64 63 !!--------------------------------------------------------------------- 65 INTEGER, INTENT(in) :: kt 64 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 65 USE wrk_nemo, ONLY: zkgco2 => wrk_2d_1 , zkgo2 => wrk_2d_2 , zh2co3 => wrk_2d_3 66 USE wrk_nemo, ONLY: zoflx => wrk_2d_4 , zkg => wrk_2d_5 67 USE wrk_nemo, ONLY: zdpco2 => wrk_2d_6 , zdpo2 => wrk_2d_7 68 ! 69 INTEGER, INTENT(in) :: kt ! 70 ! 66 71 INTEGER :: ji, jj, jrorr 67 72 REAL(wp) :: ztc, ztc2, ztc3, zws, zkgwan 68 73 REAL(wp) :: zfld, zflu, zfld16, zflu16, zfact 69 74 REAL(wp) :: zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2 70 REAL(wp), DIMENSION(jpi,jpj) :: zkgco2, zkgo2, zh2co371 #if defined key_diatrc && defined key_iomput72 REAL(wp), DIMENSION(jpi,jpj) :: zoflx, zkg, zdpco2, zdpo273 #endif74 75 CHARACTER (len=25) :: charout 75 76 76 !!--------------------------------------------------------------------- 77 78 IF( wrk_in_use(2, 1,2,3,4,5,6,7) ) THEN 79 CALL ctl_stop('p4z_flx: requested workspace arrays unavailable') ; RETURN 80 ENDIF 77 81 78 82 ! SURFACE CHEMISTRY (PCO2 AND [H+] IN … … 149 153 zfld = satmco2(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj) 150 154 zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj) 151 oce_co2(ji,jj) = ( zfld - zflu ) * rfact & 152 & * e1t(ji,jj) * e2t(ji,jj) * tmask(ji,jj,1) * 1000. 155 oce_co2(ji,jj) = ( zfld - zflu ) * rfact * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 153 156 ! compute the trend 154 157 tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) / fse3t(ji,jj,1) … … 162 165 ! Save diagnostics 163 166 # if ! defined key_iomput 164 zfact = 1. / ( e1t(ji,jj) * e2t(ji,jj)) / rfact167 zfact = 1. / e1e2t(ji,jj) / rfact 165 168 trc2d(ji,jj,jp_pcs0_2d ) = oce_co2(ji,jj) * zfact 166 169 trc2d(ji,jj,jp_pcs0_2d + 1) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1) … … 180 183 t_oce_co2_flx = t_oce_co2_flx + glob_sum( oce_co2(:,:) ) ! Cumulative Total Flux of Carbon 181 184 IF( kt == nitend ) THEN 182 t_atm_co2_flx = glob_sum( satmco2(:,:) * e1 t(:,:) *e2t(:,:) ) ! Total atmospheric pCO2185 t_atm_co2_flx = glob_sum( satmco2(:,:) * e1e2t(:,:) ) ! Total atmospheric pCO2 183 186 ! 184 187 t_oce_co2_flx = (-1.) * t_oce_co2_flx * 12. / 1.e15 ! Conversion in PgC ; negative for out of the ocean … … 203 206 204 207 # if defined key_diatrc && defined key_iomput 205 CALL iom_put( "Cflx" , oce_co2(:,:) / ( e1t(:,:) * e2t(:,:) ) / rfact )208 CALL iom_put( "Cflx" , oce_co2(:,:) / e1e2t(:,:) / rfact ) 206 209 CALL iom_put( "Oflx" , zoflx ) 207 210 CALL iom_put( "Kg" , zkg ) … … 209 212 CALL iom_put( "Dpo2" , zdpo2 ) 210 213 #endif 211 214 ! 215 IF( wrk_not_released(2, 1,2,3,4,5,6,7) ) CALL ctl_stop('p4z_flx: failed to release workspace arrays') 216 ! 212 217 END SUBROUTINE p4z_flx 213 218 219 214 220 SUBROUTINE p4z_flx_init 215 216 221 !!---------------------------------------------------------------------- 217 222 !! *** ROUTINE p4z_flx_init *** … … 222 227 !! called at the first timestep (nit000) 223 228 !! ** input : Namelist nampisext 224 !! 225 !!---------------------------------------------------------------------- 226 229 !!---------------------------------------------------------------------- 227 230 NAMELIST/nampisext/ atcco2 228 231 !!---------------------------------------------------------------------- 232 ! 229 233 REWIND( numnat ) ! read numnat 230 234 READ ( numnat, nampisext ) 231 235 ! 232 236 IF(lwp) THEN ! control print 233 237 WRITE(numout,*) ' ' … … 236 240 WRITE(numout,*) ' Atmospheric pCO2 atcco2 =', atcco2 237 241 ENDIF 238 239 ! interior global domain surface 240 area = glob_sum( e1t(:,:) * e2t(:,:) ) 241 242 ! Initialization of Flux of Carbon 243 oce_co2(:,:) = 0._wp 242 ! 243 area = glob_sum( e1e2t(:,:) ) ! interior global domain surface 244 ! 245 oce_co2(:,:) = 0._wp ! Initialization of Flux of Carbon 244 246 t_atm_co2_flx = 0._wp 245 ! Initialisation of atmospheric pco2246 satmco2(:,:) = atcco2 247 ! 248 satmco2(:,:) = atcco2 ! Initialisation of atmospheric pco2 247 249 t_oce_co2_flx = 0._wp 248 250 ! 249 251 END SUBROUTINE p4z_flx_init 252 253 254 INTEGER FUNCTION p4z_flx_alloc() 255 !!---------------------------------------------------------------------- 256 !! *** ROUTINE p4z_flx_alloc *** 257 !!---------------------------------------------------------------------- 258 ALLOCATE( oce_co2(jpi,jpj), satmco2(jpi,jpj), STAT=p4z_flx_alloc ) 259 ! 260 IF( p4z_flx_alloc /= 0 ) CALL ctl_warn('p4z_flx_alloc : failed to allocate arrays') 261 ! 262 END FUNCTION p4z_flx_alloc 250 263 251 264 #else -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zint.F90
r2528 r2715 21 21 22 22 PUBLIC p4z_int 23 PUBLIC p4z_int_alloc 23 24 24 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 25 tgfunc, & !: Temp. dependancy of various biological rates 26 tgfunc2 !: Temp. dependancy of mesozooplankton rates 25 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tgfunc !: Temp. dependancy of various biological rates 26 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tgfunc2 !: Temp. dependancy of mesozooplankton rates 27 27 28 !! * Module variables 29 REAL(wp) :: & 30 xksilim = 16.5E-6 ! Half-saturation constant for the computation of the Si half-saturation constant 31 28 REAL(wp) :: xksilim = 16.5e-6_wp ! Half-saturation constant for the Si half-saturation constant computation 32 29 33 30 !!---------------------------------------------------------------------- 34 31 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 35 32 !! $Id$ 36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 37 34 !!---------------------------------------------------------------------- 38 39 35 CONTAINS 40 36 … … 47 43 !! ** Method : - ??? 48 44 !!--------------------------------------------------------------------- 49 !!50 45 INTEGER :: ji, jj 51 46 REAL(wp) :: zdum … … 54 49 ! Computation of phyto and zoo metabolic rate 55 50 ! ------------------------------------------- 56 57 51 tgfunc (:,:,:) = EXP( 0.063913 * tsn(:,:,:,jp_tem) ) 58 52 tgfunc2(:,:,:) = EXP( 0.07608 * tsn(:,:,:,jp_tem) ) … … 61 55 ! constant for silica uptake 62 56 ! --------------------------------------------------- 63 64 57 DO ji = 1, jpi 65 58 DO jj = 1, jpj … … 68 61 END DO 69 62 END DO 70 63 ! 71 64 IF( nday_year == nyear_len(1) ) THEN 72 65 xksi = xksimax 73 xksimax = 0. e066 xksimax = 0._wp 74 67 ENDIF 75 68 ! 76 69 END SUBROUTINE p4z_int 70 71 72 INTEGER FUNCTION p4z_int_alloc() 73 !!---------------------------------------------------------------------- 74 !! *** ROUTINE p4z_int_alloc *** 75 !!---------------------------------------------------------------------- 76 ALLOCATE( tgfunc(jpi,jpj,jpk), tgfunc2(jpi,jpj,jpk), STAT=p4z_int_alloc ) 77 ! 78 IF( p4z_int_alloc /= 0 ) CALL ctl_warn('p4z_int_alloc : failed to allocate arrays.') 79 ! 80 END FUNCTION p4z_int_alloc 77 81 78 82 #else -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90
r2528 r2715 31 31 32 32 !! * Shared module variables 33 REAL(wp), PUBLIC :: & 34 kdca = 0.327e3_wp , & !: 35 nca = 1.0_wp !: 33 REAL(wp), PUBLIC :: kdca = 0.327e3_wp !: diss. rate constant calcite 34 REAL(wp), PUBLIC :: nca = 1.0_wp !: order of reaction for calcite dissolution 36 35 37 36 !! * Module variables 38 REAL(wp) :: & 39 calcon = 1.03E-2 ! mean calcite concentration [Ca2+] in sea water [mole/kg solution] 40 41 INTEGER :: & 42 rmtss !: number of seconds per month 37 REAL(wp) :: calcon = 1.03E-2 !: mean calcite concentration [Ca2+] in sea water [mole/kg solution] 38 39 INTEGER :: rmtss !: number of seconds per month 43 40 44 41 !!---------------------------------------------------------------------- … … 60 57 !! ** Method : - ??? 61 58 !!--------------------------------------------------------------------- 59 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 60 USE wrk_nemo, ONLY: zco3 => wrk_3d_2, zcaldiss => wrk_3d_3 61 ! 62 62 INTEGER, INTENT(in) :: kt ! ocean time step 63 63 INTEGER :: ji, jj, jk, jn … … 65 65 REAL(wp) :: zdispot, zfact, zalka 66 66 REAL(wp) :: zomegaca, zexcess, zexcess0 67 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zco368 67 #if defined key_diatrc && defined key_iomput 69 68 REAL(wp) :: zrfact2 70 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zcaldiss71 69 #endif 72 70 CHARACTER (len=25) :: charout 73 71 !!--------------------------------------------------------------------- 74 72 73 IF( wrk_in_use(3, 2,3) ) THEN 74 CALL ctl_stop('p4z_lys: requested workspace arrays unavailable') ; RETURN 75 END IF 76 75 77 zco3(:,:,:) = 0. 76 77 78 # if defined key_diatrc && defined key_iomput 78 79 zcaldiss(:,:,:) = 0. … … 186 187 ENDIF 187 188 189 IF( wrk_not_released(3, 2,3) ) CALL ctl_stop('p4z_lys: failed to release workspace arrays') 190 ! 188 191 END SUBROUTINE p4z_lys 189 192 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90
r2528 r2715 6 6 !! History : 1.0 ! 2004 (O. Aumont) Original code 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 !! 3.2 ! 2009-04 (C. Ethe, G. Madec) optimisa ion8 !! 3.2 ! 2009-04 (C. Ethe, G. Madec) optimisation 9 9 !!---------------------------------------------------------------------- 10 10 #if defined key_pisces … … 24 24 PUBLIC p4z_opt ! called in p4zbio.F90 module 25 25 PUBLIC p4z_opt_init ! called in trcsms_pisces.F90 module 26 27 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: etot, enano, ediat !: PAR for phyto, nano and diat 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: emoy !: averaged PAR in the mixed layer 29 30 INTEGER :: nksrp ! levels below which the light cannot penetrate ( depth larger than 391 m) 31 REAL(wp) :: parlux = 0.43 / 3.e0 32 33 REAL(wp), DIMENSION(3,61), PUBLIC :: xkrgb !: tabulated attenuation coefficients for RGB absorption 26 PUBLIC p4z_opt_alloc 27 28 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot, enano, ediat !: PAR for phyto, nano and diat 29 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy !: averaged PAR in the mixed layer 30 31 INTEGER :: nksrp ! levels below which the light cannot penetrate ( depth larger than 391 m) 32 REAL(wp) :: parlux = 0.43_wp / 3._wp 33 34 REAL(wp), DIMENSION(3,61), PUBLIC :: xkrgb !: tabulated attenuation coefficients for RGB absorption 34 35 35 36 !!* Substitution … … 38 39 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 39 40 !! $Id$ 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 41 !!---------------------------------------------------------------------- 42 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 42 !!---------------------------------------------------------------------- 43 43 CONTAINS 44 44 … … 52 52 !! ** Method : - ??? 53 53 !!--------------------------------------------------------------------- 54 INTEGER, INTENT(in) :: kt, jnt ! ocean time step 54 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 55 USE wrk_nemo, ONLY: zdepmoy => wrk_2d_1 , zetmp => wrk_2d_2 56 USE wrk_nemo, ONLY: zekg => wrk_3d_2 , zekr => wrk_3d_3 , zekb => wrk_3d_4 57 USE wrk_nemo, ONLY: ze0 => wrk_3d_5 , ze1 => wrk_3d_6 58 USE wrk_nemo, ONLY: ze2 => wrk_3d_7 , ze3 => wrk_3d_8 59 ! 60 INTEGER, INTENT(in) :: kt, jnt ! ocean time step 61 ! 55 62 INTEGER :: ji, jj, jk 56 63 INTEGER :: irgb 57 64 REAL(wp) :: zchl, zxsi0r 58 65 REAL(wp) :: zc0 , zc1 , zc2, zc3 59 REAL(wp), DIMENSION(jpi,jpj) :: zdepmoy, zetmp60 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zekg, zekr, zekb61 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze1 , ze2 , ze3, ze062 66 !!--------------------------------------------------------------------- 63 67 68 IF( wrk_in_use(2, 1,2) .OR. wrk_in_use(3, 2,3,4,5,6,7,8) ) THEN 69 CALL ctl_stop('p4z_opt: requested workspace arrays unavailable') ; RETURN 70 ENDIF 64 71 65 72 ! Initialisation of variables used to compute PAR 66 73 ! ----------------------------------------------- 67 ze1 (:,:,jpk) = 0. e068 ze2 (:,:,jpk) = 0. e069 ze3 (:,:,jpk) = 0. e074 ze1 (:,:,jpk) = 0._wp 75 ze2 (:,:,jpk) = 0._wp 76 ze3 (:,:,jpk) = 0._wp 70 77 71 78 ! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) … … 203 210 !CDIR NOVERRCHK 204 211 DO ji = 1, jpi 205 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) & 206 & emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn ) 212 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn ) 207 213 END DO 208 214 END DO … … 223 229 #endif 224 230 ! 231 IF( wrk_not_released(2, 1,2) .OR. & 232 wrk_not_released(3, 2,3,4,5,6,7,8) ) CALL ctl_stop('p4z_opt: failed to release workspace arrays') 233 ! 225 234 END SUBROUTINE p4z_opt 235 226 236 227 237 SUBROUTINE p4z_opt_init … … 230 240 !! 231 241 !! ** Purpose : Initialization of tabulated attenuation coef 232 !! 233 !! 234 !!---------------------------------------------------------------------- 235 242 !!---------------------------------------------------------------------- 243 ! 236 244 CALL trc_oce_rgb( xkrgb ) ! tabulated attenuation coefficients 237 !! CALL trc_oce_rgb_read( xkrgb ) ! tabulated attenuation coefficients238 245 nksrp = trc_oce_ext_lev( r_si2, 0.33e2 ) ! max level of light extinction (Blue Chl=0.01) 246 ! 239 247 IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m' 240 248 ! 241 etot (:,:,:) = 0. e0242 enano(:,:,:) = 0. e0243 ediat(:,:,:) = 0. e0244 IF( ln_qsr_bio ) etot3(:,:,:) = 0. e0249 etot (:,:,:) = 0._wp 250 enano(:,:,:) = 0._wp 251 ediat(:,:,:) = 0._wp 252 IF( ln_qsr_bio ) etot3(:,:,:) = 0._wp 245 253 ! 246 254 END SUBROUTINE p4z_opt_init 255 256 257 INTEGER FUNCTION p4z_opt_alloc() 258 !!---------------------------------------------------------------------- 259 !! *** ROUTINE p4z_opt_alloc *** 260 !!---------------------------------------------------------------------- 261 ALLOCATE( etot (jpi,jpj,jpk) , enano(jpi,jpj,jpk) , & 262 & ediat(jpi,jpj,jpk) , emoy (jpi,jpj,jpk) , STAT=p4z_opt_alloc ) 263 ! 264 IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.') 265 ! 266 END FUNCTION p4z_opt_alloc 267 247 268 #else 248 269 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90
r2528 r2715 22 22 USE iom 23 23 24 USE lib_mpp25 USE lib_fortran26 27 24 IMPLICIT NONE 28 25 PRIVATE … … 30 27 PUBLIC p4z_prod ! called in p4zbio.F90 31 28 PUBLIC p4z_prod_init ! called in trcsms_pisces.F90 32 33 !! * Shared module variables 29 PUBLIC p4z_prod_alloc 30 34 31 REAL(wp), PUBLIC :: & 35 32 pislope = 3.0_wp , & !: … … 43 40 grosip = 0.151_wp 44 41 45 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: prmax42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prmax !: 46 43 47 44 REAL(wp) :: & … … 56 53 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 57 54 !! $Id$ 58 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 59 !!---------------------------------------------------------------------- 60 55 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 56 !!---------------------------------------------------------------------- 61 57 CONTAINS 62 58 … … 70 66 !! ** Method : - ??? 71 67 !!--------------------------------------------------------------------- 68 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 69 USE wrk_nemo, ONLY: zmixnano => wrk_2d_1 , zmixdiat => wrk_2d_2 , zstrn => wrk_2d_3 70 USE wrk_nemo, ONLY: zpislopead => wrk_3d_2 , zpislopead2 => wrk_3d_3 71 USE wrk_nemo, ONLY: zprdia => wrk_3d_4 , zprbio => wrk_3d_5 , zysopt => wrk_3d_6 72 USE wrk_nemo, ONLY: zprorca => wrk_3d_7 , zprorcad => wrk_3d_8 73 USE wrk_nemo, ONLY: zprofed => wrk_3d_9 , zprofen => wrk_3d_10 74 USE wrk_nemo, ONLY: zprochln => wrk_3d_11 , zprochld => wrk_3d_12 75 USE wrk_nemo, ONLY: zpronew => wrk_3d_13 , zpronewd => wrk_3d_14 76 ! 72 77 INTEGER, INTENT(in) :: kt, jnt 78 ! 73 79 INTEGER :: ji, jj, jk 74 80 REAL(wp) :: zsilfac, zfact … … 81 87 REAL(wp) :: zrfact2 82 88 #endif 83 REAL(wp), DIMENSION(jpi,jpj) :: zmixnano , zmixdiat, zstrn84 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpislopead , zpislopead285 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprdia , zprbio, zysopt86 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprorca , zprorcad, zprofed87 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprofen , zprochln, zprochld88 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpronew , zpronewd89 89 CHARACTER (len=25) :: charout 90 90 !!--------------------------------------------------------------------- 91 91 92 zprorca (:,:,:) = 0.0 93 zprorcad(:,:,:) = 0.0 94 zprofed(:,:,:) = 0.0 95 zprofen(:,:,:) = 0.0 96 zprochln(:,:,:) = 0.0 97 zprochld(:,:,:) = 0.0 98 zpronew (:,:,:) = 0.0 99 zpronewd(:,:,:) = 0.0 100 zprdia (:,:,:) = 0.0 101 zprbio (:,:,:) = 0.0 102 zysopt (:,:,:) = 0.0 92 IF( wrk_in_use(2, 1,2,3) .OR. & 93 wrk_in_use(3, 2,3,4,5,6,7,8,9,10,11,12,13,14) ) THEN 94 CALL ctl_stop('p4z_prod: requested workspace arrays unavailable') ; RETURN 95 ENDIF 96 97 zprorca (:,:,:) = 0._wp 98 zprorcad(:,:,:) = 0._wp 99 zprofed (:,:,:) = 0._wp 100 zprofen (:,:,:) = 0._wp 101 zprochln(:,:,:) = 0._wp 102 zprochld(:,:,:) = 0._wp 103 zpronew (:,:,:) = 0._wp 104 zpronewd(:,:,:) = 0._wp 105 zprdia (:,:,:) = 0._wp 106 zprbio (:,:,:) = 0._wp 107 zysopt (:,:,:) = 0._wp 103 108 104 109 ! Computation of the optimal production 105 106 110 # if defined key_degrad 107 111 prmax(:,:,:) = rday1 * tgfunc(:,:,:) * facvol(:,:,:) … … 111 115 112 116 ! compute the day length depending on latitude and the day 113 zrum = FLOAT( nday_year - 80 ) / REAL(nyear_len(1), wp)114 zcodel = ASIN( SIN( zrum * rpi * 2. ) * SIN( rad * 23.5) )117 zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp ) 118 zcodel = ASIN( SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp ) ) 115 119 116 120 ! day length in hours 117 zstrn(:,:) = 0. 121 zstrn(:,:) = 0._wp 118 122 DO jj = 1, jpj 119 123 DO ji = 1, jpi … … 187 191 zsilfac = MIN( 6.4,zsilfac * zsilfac2) 188 192 zysopt(ji,jj,jk) = grosip * zlim1 * zsilfac 189 190 193 ENDIF 191 194 END DO … … 357 360 #endif 358 361 359 362 IF(ln_ctl) THEN ! print mean trends (used for debugging) 360 363 WRITE(charout, FMT="('prod')") 361 364 CALL prt_ctl_trc_info(charout) 362 365 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 363 ENDIF 364 366 ENDIF 367 368 IF( wrk_not_released(2, 1,2,3) .OR. & 369 wrk_not_released(3, 2,3,4,5,6,7,8,9,10,11,12,13,14) ) & 370 CALL ctl_stop('p4z_prod: failed to release workspace arrays') 371 ! 365 372 END SUBROUTINE p4z_prod 366 373 374 367 375 SUBROUTINE p4z_prod_init 368 369 376 !!---------------------------------------------------------------------- 370 377 !! *** ROUTINE p4z_prod_init *** … … 376 383 !! 377 384 !! ** input : Namelist nampisprod 378 !!379 385 !!---------------------------------------------------------------------- 380 381 386 NAMELIST/nampisprod/ pislope, pislope2, excret, excret2, chlcnm, chlcdm, & 382 387 & fecnm, fecdm, grosip 388 !!---------------------------------------------------------------------- 383 389 384 390 REWIND( numnat ) ! read numnat … … 399 405 WRITE(numout,*) ' Minimum Fe/C in diatoms fecdm =', fecdm 400 406 ENDIF 401 407 ! 402 408 rday1 = 0.6 / rday 403 409 texcret = 1.0 - excret 404 410 texcret2 = 1.0 - excret2 405 411 tpp = 0. 406 412 ! 407 413 END SUBROUTINE p4z_prod_init 408 414 409 415 416 INTEGER FUNCTION p4z_prod_alloc() 417 !!---------------------------------------------------------------------- 418 !! *** ROUTINE p4z_prod_alloc *** 419 !!---------------------------------------------------------------------- 420 ALLOCATE( prmax(jpi,jpj,jpk), STAT=p4z_prod_alloc ) 421 ! 422 IF( p4z_prod_alloc /= 0 ) CALL ctl_warn('p4z_prod_alloc : failed to allocate arrays.') 423 ! 424 END FUNCTION p4z_prod_alloc 410 425 411 426 #else -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90
r2528 r2715 29 29 PUBLIC p4z_rem ! called in p4zbio.F90 30 30 PUBLIC p4z_rem_init ! called in trcsms_pisces.F90 31 32 !! * Shared module variables 31 PUBLIC p4z_rem_alloc 32 33 33 REAL(wp), PUBLIC :: & 34 34 xremik = 0.3_wp , & !: … … 39 39 oxymin = 1.e-6_wp !: 40 40 41 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 42 & denitr !: denitrification array 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitr !: denitrification array 43 42 44 43 … … 48 47 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 49 48 !! $Id$ 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 51 !!---------------------------------------------------------------------- 52 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 !!---------------------------------------------------------------------- 53 51 CONTAINS 54 52 … … 61 59 !! ** Method : - ??? 62 60 !!--------------------------------------------------------------------- 61 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 62 USE wrk_nemo, ONLY: ztempbac => wrk_2d_1 63 USE wrk_nemo, ONLY: zdepbac => wrk_3d_2 , zfesatur => wrk_3d_2 , zolimi => wrk_3d_4 64 ! 63 65 INTEGER, INTENT(in) :: kt ! ocean time step 66 ! 64 67 INTEGER :: ji, jj, jk 65 68 REAL(wp) :: zremip, zremik , zlam1b … … 72 75 #endif 73 76 REAL(wp) :: zlamfac, zonitr, zstep 74 REAL(wp), DIMENSION(jpi,jpj) :: ztempbac75 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepbac, zfesatur, zolimi76 77 CHARACTER (len=25) :: charout 77 78 78 !!--------------------------------------------------------------------- 79 79 80 IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 2,3,4) ) THEN 81 CALL ctl_stop('p4z_rem: requested workspace arrays unavailable') ; RETURN 82 ENDIF 80 83 81 84 ! Initialisation of temprary arrys 82 zdepbac (:,:,:) = 0. 083 zfesatur(:,:,:) = 0. 084 zolimi (:,:,:) = 0. 085 ztempbac(:,:) = 0. 085 zdepbac (:,:,:) = 0._wp 86 zfesatur(:,:,:) = 0._wp 87 zolimi (:,:,:) = 0._wp 88 ztempbac(:,:) = 0._wp 86 89 87 90 ! Computation of the mean phytoplankton concentration as 88 91 ! a crude estimate of the bacterial biomass 89 92 ! -------------------------------------------------- 90 91 93 DO jk = 1, jpkm1 92 94 DO jj = 1, jpj … … 362 364 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 363 365 #endif 364 365 END DO 366 END DO 367 END DO 368 ! 369 370 IF(ln_ctl) THEN ! print mean trends (used for debugging) 366 END DO 367 END DO 368 END DO 369 ! 370 371 IF(ln_ctl) THEN ! print mean trends (used for debugging) 371 372 WRITE(charout, FMT="('rem5')") 372 373 CALL prt_ctl_trc_info(charout) 373 374 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 374 375 376 377 375 ENDIF 376 377 ! Update the arrays TRA which contain the biological sources and sinks 378 ! -------------------------------------------------------------------- 378 379 379 380 DO jk = 1, jpkm1 … … 385 386 tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi(:,:,jk) + denitr(:,:,jk) 386 387 tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + denitr(:,:,jk) * rno3 * rdenit 387 END DO388 389 388 END DO 389 390 IF(ln_ctl) THEN ! print mean trends (used for debugging) 390 391 WRITE(charout, FMT="('rem6')") 391 392 CALL prt_ctl_trc_info(charout) 392 393 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 393 ENDIF 394 394 ENDIF 395 ! 396 IF( wrk_not_released(2, 1) .OR. & 397 wrk_not_released(3, 2,3,4) ) CALL ctl_stop('p4z_rem: failed to release workspace arrays') 398 ! 395 399 END SUBROUTINE p4z_rem 396 400 401 397 402 SUBROUTINE p4z_rem_init 398 399 403 !!---------------------------------------------------------------------- 400 404 !! *** ROUTINE p4z_rem_init *** … … 408 412 !! 409 413 !!---------------------------------------------------------------------- 410 411 414 NAMELIST/nampisrem/ xremik, xremip, nitrif, xsirem, xlam1, oxymin 415 !!---------------------------------------------------------------------- 412 416 413 417 REWIND( numnat ) ! read numnat … … 425 429 WRITE(numout,*) ' halk saturation constant for anoxia oxymin =', oxymin 426 430 ENDIF 427 428 nitrfac(:,:,:) = 0. 0429 denitr (:,:,:) = 0. 0430 431 ! 432 nitrfac(:,:,:) = 0._wp 433 denitr (:,:,:) = 0._wp 434 ! 431 435 END SUBROUTINE p4z_rem_init 436 437 438 INTEGER FUNCTION p4z_rem_alloc() 439 !!---------------------------------------------------------------------- 440 !! *** ROUTINE p4z_rem_alloc *** 441 !!---------------------------------------------------------------------- 442 ALLOCATE( denitr(jpi,jpj,jpk), STAT=p4z_rem_alloc ) 443 ! 444 IF( p4z_rem_alloc /= 0 ) CALL ctl_warn('p4z_rem_alloc: failed to allocate arrays') 445 ! 446 END FUNCTION p4z_rem_alloc 432 447 433 448 #else -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90
r2528 r2715 18 18 USE oce_trc ! 19 19 USE sms_pisces 20 USE lib_mpp21 USE lib_fortran22 20 USE prtctl_trc 23 21 USE p4zbio … … 27 25 USE p4zrem 28 26 USE p4zlim 29 USE lbclnk30 27 USE iom 31 28 … … 36 33 PUBLIC p4z_sed 37 34 PUBLIC p4z_sed_init 35 PUBLIC p4z_sed_alloc 38 36 39 37 !! * Shared module variables 40 LOGICAL, PUBLIC :: & 41 ln_dustfer = .FALSE. , & !: 42 ln_river = .FALSE. , & !: 43 ln_ndepo = .FALSE. , & !: 44 ln_sedinput = .FALSE. !: 45 46 REAL(wp), PUBLIC :: & 47 sedfeinput = 1.E-9_wp , & !: 48 dustsolub = 0.014_wp !: 38 LOGICAL, PUBLIC :: ln_dustfer = .FALSE. !: boolean for dust input from the atmosphere 39 LOGICAL, PUBLIC :: ln_river = .FALSE. !: boolean for river input of nutrients 40 LOGICAL, PUBLIC :: ln_ndepo = .FALSE. !: boolean for atmospheric deposition of N 41 LOGICAL, PUBLIC :: ln_sedinput = .FALSE. !: boolean for Fe input from sediments 42 43 REAL(wp), PUBLIC :: sedfeinput = 1.E-9_wp !: Coastal release of Iron 44 REAL(wp), PUBLIC :: dustsolub = 0.014_wp !: Solubility of the dust 49 45 50 46 !! * Module variables 51 REAL(wp) :: ryyss !: number of seconds per year 52 REAL(wp) :: ryyss1 !: inverse of ryyss 53 REAL(wp) :: rmtss !: number of seconds per month 54 REAL(wp) :: rday1 !: inverse of rday 55 56 INTEGER , PARAMETER :: & 57 jpmth = 12, jpyr = 1 58 INTEGER :: & 59 numdust, & !: logical unit for surface fluxes data 60 nflx1 , nflx2, & !: first and second record used 61 nflx11, nflx12 ! ??? 62 REAL(wp), DIMENSION(jpi,jpj,jpmth) :: dustmo !: set of dust fields 63 REAL(wp), DIMENSION(jpi,jpj) :: rivinp, cotdep, nitdep, dust 64 REAL(wp), DIMENSION(jpi,jpj) :: e1e2t 65 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ironsed 47 REAL(wp) :: ryyss !: number of seconds per year 48 REAL(wp) :: ryyss1 !: inverse of ryyss 49 REAL(wp) :: rmtss !: number of seconds per month 50 REAL(wp) :: rday1 !: inverse of rday 51 52 INTEGER , PARAMETER :: jpmth = 12 !: number of months per year 53 INTEGER , PARAMETER :: jpyr = 1 !: one year 54 55 INTEGER :: numdust !: logical unit for surface fluxes data 56 INTEGER :: nflx1 , nflx2 !: first and second record used 57 INTEGER :: nflx11, nflx12 58 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dustmo !: set of dust fields 60 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: dust !: dust fields 61 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivinp, cotdep !: river input fields 62 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nitdep !: atmospheric N deposition 63 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ironsed !: Coastal supply of iron 64 66 65 REAL(wp) :: sumdepsi, rivalkinput, rivpo4input, nitdepinput 67 66 … … 76 75 CONTAINS 77 76 77 78 78 SUBROUTINE p4z_sed( kt, jnt ) 79 79 !!--------------------------------------------------------------------- … … 86 86 !! ** Method : - ??? 87 87 !!--------------------------------------------------------------------- 88 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 89 USE wrk_nemo, ONLY: zsidep => wrk_2d_1, zwork => wrk_2d_2, zwork1 => wrk_2d_3 90 USE wrk_nemo, ONLY: znitrpot => wrk_3d_2, zirondep => wrk_3d_3 91 ! 88 92 INTEGER, INTENT(in) :: kt, jnt ! ocean time step 89 93 INTEGER :: ji, jj, jk, ikt … … 94 98 REAL(wp) :: zdenitot, znitrpottot, zlim, zfact 95 99 REAL(wp) :: zwsbio3, zwsbio4, zwscal 96 REAL(wp), DIMENSION(jpi,jpj) :: zsidep97 REAL(wp), DIMENSION(jpi,jpj) :: zwork, zwork198 REAL(wp), DIMENSION(jpi,jpj,jpk) :: znitrpot, zirondep99 100 CHARACTER (len=25) :: charout 100 101 !!--------------------------------------------------------------------- 102 103 IF( ( wrk_in_use(2, 1,2,3) ) .OR. ( wrk_in_use(3, 2,3) ) ) THEN 104 CALL ctl_stop('p4z_sed: requested workspace arrays unavailable') ; RETURN 105 END IF 101 106 102 107 IF( jnt == 1 .AND. ln_dustfer ) CALL p4z_sbc( kt ) … … 288 293 ENDIF 289 294 295 IF( ( wrk_not_released(2, 1,2,3) ) .OR. ( wrk_not_released(3, 2,3) ) ) & 296 & CALL ctl_stop('p4z_sed: failed to release workspace arrays') 297 290 298 END SUBROUTINE p4z_sed 291 299 … … 474 482 ryyss1 = 1. / ryyss 475 483 ! ! ocean surface cell 476 e1e2t(:,:) = e1t(:,:) * e2t(:,:)477 484 478 485 ! total atmospheric supply of Si … … 512 519 END SUBROUTINE p4z_sed_init 513 520 521 INTEGER FUNCTION p4z_sed_alloc() 522 !!---------------------------------------------------------------------- 523 !! *** ROUTINE p4z_sed_alloc *** 524 !!---------------------------------------------------------------------- 525 526 ALLOCATE( dustmo(jpi,jpj,jpmth), dust(jpi,jpj) , & 527 & rivinp(jpi,jpj) , cotdep(jpi,jpj) , & 528 & nitdep(jpi,jpj) , ironsed(jpi,jpj,jpk), STAT=p4z_sed_alloc ) 529 530 IF( p4z_sed_alloc /= 0 ) CALL ctl_warn('p4z_sed_alloc : failed to allocate arrays.') 531 532 END FUNCTION p4z_sed_alloc 514 533 #else 515 534 !!====================================================================== -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90
r2528 r2715 21 21 PUBLIC p4z_sink ! called in p4zbio.F90 22 22 PUBLIC p4z_sink_init ! called in trcsms_pisces.F90 23 24 !! * Shared module variables 25 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 26 wsbio3, wsbio4, & !: POC and GOC sinking speeds 27 wscal !: Calcite and BSi sinking speeds 28 29 !! * Module variables 30 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 31 sinking, sinking2, & !: POC sinking fluxes (different meanings depending on the parameterization 32 sinkcal, sinksil, & !: CaCO3 and BSi sinking fluxes 33 sinkfer !: Small BFe sinking flux 34 35 INTEGER :: & 36 iksed = 10 ! 23 PUBLIC p4z_sink_alloc 24 25 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wsbio3 !: POC sinking speed 26 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wsbio4 !: GOC sinking speed 27 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wscal !: Calcite and BSi sinking speeds 28 29 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinking, sinking2 !: POC sinking fluxes 30 ! ! (different meanings depending on the parameterization) 31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkcal, sinksil !: CaCO3 and BSi sinking fluxes 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkfer !: Small BFe sinking fluxes 33 #if ! defined key_kriest 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkfer2 !: Big iron sinking fluxes 35 #endif 36 37 INTEGER :: iksed = 10 37 38 38 39 #if defined key_kriest 39 REAL(wp) :: & 40 xkr_sfact = 250. , & !: Sinking factor 41 xkr_stick = 0.2 , & !: Stickiness 42 xkr_nnano = 2.337 , & !: Nbr of cell in nano size class 43 xkr_ndiat = 3.718 , & !: Nbr of cell in diatoms size class 44 xkr_nmeso = 7.147 , & !: Nbr of cell in mesozoo size class 45 xkr_naggr = 9.877 !: Nbr of cell in aggregates size class 46 47 REAL(wp) :: & 48 xkr_frac 49 50 REAL(wp), PUBLIC :: & 51 xkr_dnano , & !: Size of particles in nano pool 52 xkr_ddiat , & !: Size of particles in diatoms pool 53 xkr_dmeso , & !: Size of particles in mesozoo pool 54 xkr_daggr , & !: Size of particles in aggregates pool 55 xkr_wsbio_min , & !: min vertical particle speed 56 xkr_wsbio_max !: max vertical particle speed 57 58 REAL(wp), PUBLIC, DIMENSION(jpk) :: & !: 59 xnumm !: maximum number of particles in aggregates 60 61 #endif 62 63 #if ! defined key_kriest 64 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & !: 65 sinkfer2 !: Big Fe sinking flux 66 #endif 40 REAL(wp) :: xkr_sfact = 250. !: Sinking factor 41 REAL(wp) :: xkr_stick = 0.2 !: Stickiness 42 REAL(wp) :: xkr_nnano = 2.337 !: Nbr of cell in nano size class 43 REAL(wp) :: xkr_ndiat = 3.718 !: Nbr of cell in diatoms size class 44 REAL(wp) :: xkr_nmeso = 7.147 !: Nbr of cell in mesozoo size class 45 REAL(wp) :: xkr_naggr = 9.877 !: Nbr of cell in aggregates size class 46 47 REAL(wp) :: xkr_frac 48 49 REAL(wp), PUBLIC :: xkr_dnano !: Size of particles in nano pool 50 REAL(wp), PUBLIC :: xkr_ddiat !: Size of particles in diatoms pool 51 REAL(wp), PUBLIC :: xkr_dmeso !: Size of particles in mesozoo pool 52 REAL(wp), PUBLIC :: xkr_daggr !: Size of particles in aggregates pool 53 REAL(wp), PUBLIC :: xkr_wsbio_min !: min vertical particle speed 54 REAL(wp), PUBLIC :: xkr_wsbio_max !: max vertical particle speed 55 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: xnumm !: maximum number of particles in aggregates 57 #endif 67 58 68 59 !!* Substitution … … 71 62 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 72 63 !! $Id$ 73 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)64 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 74 65 !!---------------------------------------------------------------------- 75 76 66 CONTAINS 77 67 78 68 #if defined key_kriest 69 !!---------------------------------------------------------------------- 70 !! 'key_kriest' ??? 71 !!---------------------------------------------------------------------- 79 72 80 73 SUBROUTINE p4z_sink ( kt, jnt ) … … 87 80 !! ** Method : - ??? 88 81 !!--------------------------------------------------------------------- 89 82 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 83 USE wrk_nemo, ONLY: znum3d => wrk_3d_2 84 ! 90 85 INTEGER, INTENT(in) :: kt, jnt 86 ! 91 87 INTEGER :: ji, jj, jk 92 88 REAL(wp) :: zagg1, zagg2, zagg3, zagg4, zagg5, zaggsi, zaggsh … … 99 95 INTEGER :: ik1 100 96 #endif 101 REAL(wp), DIMENSION(jpi,jpj,jpk) :: znum3d102 97 CHARACTER (len=25) :: charout 103 104 !!--------------------------------------------------------------------- 105 98 !!--------------------------------------------------------------------- 99 ! 100 IF( wrk_in_use(3, 2 ) ) THEN 101 CALL ctl_stop('p4z_sink: requested workspace arrays unavailable') ; RETURN 102 ENDIF 103 106 104 ! Initialisation of variables used to compute Sinking Speed 107 105 ! --------------------------------------------------------- 108 106 109 110 111 112 113 114 ! Computation of the vertical sinking speed : Kriest et Evans, 2000115 ! -----------------------------------------------------------------107 znum3d(:,:,:) = 0.e0 108 zval1 = 1. + xkr_zeta 109 zval2 = 1. + xkr_zeta + xkr_eta 110 zval3 = 1. + xkr_eta 111 112 ! Computation of the vertical sinking speed : Kriest et Evans, 2000 113 ! ----------------------------------------------------------------- 116 114 117 115 DO jk = 1, jpkm1 … … 131 129 zdiv1 = zeps - zval3 132 130 wsbio3(ji,jj,jk) = xkr_wsbio_min * ( zeps - zval1 ) / zdiv & 133 &- xkr_wsbio_max * zgm * xkr_eta / zdiv131 & - xkr_wsbio_max * zgm * xkr_eta / zdiv 134 132 wsbio4(ji,jj,jk) = xkr_wsbio_min * ( zeps-1. ) / zdiv1 & 135 &- xkr_wsbio_max * zfm * xkr_eta / zdiv1133 & - xkr_wsbio_max * zfm * xkr_eta / zdiv1 136 134 IF( znum == 1.1) wsbio3(ji,jj,jk) = wsbio4(ji,jj,jk) 137 135 ENDIF … … 140 138 END DO 141 139 142 wscal(:,:,:) = MAX( wsbio3(:,:,:), 50. )140 wscal(:,:,:) = MAX( wsbio3(:,:,:), 50._wp ) 143 141 144 142 ! INITIALIZE TO ZERO ALL THE SINKING ARRAYS … … 305 303 #endif 306 304 ! 307 305 IF(ln_ctl) THEN ! print mean trends (used for debugging) 308 306 WRITE(charout, FMT="('sink')") 309 307 CALL prt_ctl_trc_info(charout) 310 308 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 311 ENDIF 312 309 ENDIF 310 ! 311 IF( wrk_not_released(3, 2 ) ) CALL ctl_stop('p4z_sink: failed to release workspace arrays') 312 ! 313 313 END SUBROUTINE p4z_sink 314 314 315 315 316 SUBROUTINE p4z_sink_init … … 324 325 !! 325 326 !! ** input : Namelist nampiskrs 326 !!327 327 !!---------------------------------------------------------------------- 328 328 INTEGER :: jk, jn, kiter … … 330 330 REAL(wp) :: zws, zwr, zwl,wmax, znummax 331 331 REAL(wp) :: zmin, zmax, zl, zr, xacc 332 332 ! 333 333 NAMELIST/nampiskrs/ xkr_sfact, xkr_stick , & 334 334 & xkr_nnano, xkr_ndiat, xkr_nmeso, xkr_naggr 335 336 335 !!---------------------------------------------------------------------- 336 ! 337 337 REWIND( numnat ) ! read nampiskrs 338 338 READ ( numnat, nampiskrs ) … … 347 347 WRITE(numout,*) ' Nbr of cell in mesozoo size class xkr_nmeso = ', xkr_nmeso 348 348 WRITE(numout,*) ' Nbr of cell in aggregates size class xkr_naggr = ', xkr_naggr 349 ENDIF350 351 352 ! max and min vertical particle speed353 xkr_wsbio_min = xkr_sfact * xkr_mass_min**xkr_eta354 xkr_wsbio_max = xkr_sfact * xkr_mass_max**xkr_eta355 WRITE(numout,*) ' max and min vertical particle speed ', xkr_wsbio_min, xkr_wsbio_max356 357 !358 ! effect of the sizes of the different living pools on particle numbers359 ! nano = 2um-20um -> mean size=6.32 um -> ws=2.596 -> xnum=xnnano=2.337360 ! diat and microzoo = 10um-200um -> 44.7 -> 8.732 -> xnum=xndiat=3.718361 ! mesozoo = 200um-2mm -> 632.45 -> 45.14 -> xnum=xnmeso=7.147362 ! aggregates = 200um-10mm -> 1414 -> 74.34 -> xnum=xnaggr=9.877363 ! doc aggregates = 1um364 ! ----------------------------------------------------------365 366 xkr_dnano = 1. / ( xkr_massp * xkr_nnano )367 xkr_ddiat = 1. / ( xkr_massp * xkr_ndiat )368 xkr_dmeso = 1. / ( xkr_massp * xkr_nmeso )369 xkr_daggr = 1. / ( xkr_massp * xkr_naggr )349 ENDIF 350 351 352 ! max and min vertical particle speed 353 xkr_wsbio_min = xkr_sfact * xkr_mass_min**xkr_eta 354 xkr_wsbio_max = xkr_sfact * xkr_mass_max**xkr_eta 355 WRITE(numout,*) ' max and min vertical particle speed ', xkr_wsbio_min, xkr_wsbio_max 356 357 ! 358 ! effect of the sizes of the different living pools on particle numbers 359 ! nano = 2um-20um -> mean size=6.32 um -> ws=2.596 -> xnum=xnnano=2.337 360 ! diat and microzoo = 10um-200um -> 44.7 -> 8.732 -> xnum=xndiat=3.718 361 ! mesozoo = 200um-2mm -> 632.45 -> 45.14 -> xnum=xnmeso=7.147 362 ! aggregates = 200um-10mm -> 1414 -> 74.34 -> xnum=xnaggr=9.877 363 ! doc aggregates = 1um 364 ! ---------------------------------------------------------- 365 366 xkr_dnano = 1. / ( xkr_massp * xkr_nnano ) 367 xkr_ddiat = 1. / ( xkr_massp * xkr_ndiat ) 368 xkr_dmeso = 1. / ( xkr_massp * xkr_nmeso ) 369 xkr_daggr = 1. / ( xkr_massp * xkr_naggr ) 370 370 371 371 !!--------------------------------------------------------------------- … … 379 379 WRITE(numout,*)' kriest : Compute maximum number of particles in aggregates' 380 380 381 xacc = 0.001 381 xacc = 0.001_wp 382 382 kiter = 50 383 zmin = 1.10 383 zmin = 1.10_wp 384 384 zmax = xkr_mass_max / xkr_mass_min 385 385 xkr_frac = zmax … … 402 402 & xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 403 403 & - wmax 404 iflag: DO jn = 1, kiter 405 IF( zwl == 0.e0 ) THEN 406 znummax = zl 407 ELSE IF ( zwr == 0.e0 ) THEN 408 znummax = zr 409 ELSE 410 znummax = ( zr + zl ) / 2. 411 zdiv = xkr_zeta + xkr_eta - xkr_eta * znummax 412 znum = znummax - 1. 413 zws = xkr_wsbio_min * xkr_zeta / zdiv & 414 & - ( xkr_wsbio_max * xkr_eta * znum * & 415 & xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 416 & - wmax 417 IF( zws * zwl < 0. ) THEN 418 zr = znummax 419 ELSE 420 zl = znummax 421 ENDIF 422 zdiv = xkr_zeta + xkr_eta - xkr_eta * zl 423 znum = zl - 1. 424 zwl = xkr_wsbio_min * xkr_zeta / zdiv & 425 & - ( xkr_wsbio_max * xkr_eta * znum * & 426 & xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 427 & - wmax 428 429 zdiv = xkr_zeta + xkr_eta - xkr_eta * zr 430 znum = zr - 1. 431 zwr = xkr_wsbio_min * xkr_zeta / zdiv & 432 & - ( xkr_wsbio_max * xkr_eta * znum * & 433 & xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 434 & - wmax 435 436 IF ( ABS ( zws ) <= xacc ) EXIT iflag 437 438 ENDIF 439 440 END DO iflag 441 442 xnumm(jk) = znummax 443 WRITE(numout,*) ' jk = ', jk, ' wmax = ', wmax,' xnum max = ', xnumm(jk) 444 445 END DO 446 404 iflag: DO jn = 1, kiter 405 IF ( zwl == 0._wp ) THEN ; znummax = zl 406 ELSEIF( zwr == 0._wp ) THEN ; znummax = zr 407 ELSE 408 znummax = ( zr + zl ) / 2. 409 zdiv = xkr_zeta + xkr_eta - xkr_eta * znummax 410 znum = znummax - 1. 411 zws = xkr_wsbio_min * xkr_zeta / zdiv & 412 & - ( xkr_wsbio_max * xkr_eta * znum * & 413 & xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 414 & - wmax 415 IF( zws * zwl < 0. ) THEN ; zr = znummax 416 ELSE ; zl = znummax 417 ENDIF 418 zdiv = xkr_zeta + xkr_eta - xkr_eta * zl 419 znum = zl - 1. 420 zwl = xkr_wsbio_min * xkr_zeta / zdiv & 421 & - ( xkr_wsbio_max * xkr_eta * znum * & 422 & xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 423 & - wmax 424 425 zdiv = xkr_zeta + xkr_eta - xkr_eta * zr 426 znum = zr - 1. 427 zwr = xkr_wsbio_min * xkr_zeta / zdiv & 428 & - ( xkr_wsbio_max * xkr_eta * znum * & 429 & xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 430 & - wmax 431 ! 432 IF ( ABS ( zws ) <= xacc ) EXIT iflag 433 ! 434 ENDIF 435 ! 436 END DO iflag 437 438 xnumm(jk) = znummax 439 WRITE(numout,*) ' jk = ', jk, ' wmax = ', wmax,' xnum max = ', xnumm(jk) 440 ! 441 END DO 442 ! 447 443 END SUBROUTINE p4z_sink_init 448 444 … … 476 472 DO jj = 1, jpj 477 473 DO ji=1,jpi 478 zfact = MAX( 0., fsdepw(ji,jj,jk+1) - hmld(ji,jj) ) / 4000. 474 zfact = MAX( 0., fsdepw(ji,jj,jk+1) - hmld(ji,jj) ) / 4000._wp 479 475 wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact 480 476 END DO … … 584 580 #endif 585 581 ! 586 582 IF(ln_ctl) THEN ! print mean trends (used for debugging) 587 583 WRITE(charout, FMT="('sink')") 588 584 CALL prt_ctl_trc_info(charout) 589 585 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 590 591 586 ENDIF 587 ! 592 588 END SUBROUTINE p4z_sink 589 593 590 594 591 SUBROUTINE p4z_sink_init … … 611 608 !! transport term, i.e. div(u*tra). 612 609 !!--------------------------------------------------------------------- 610 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 611 USE wrk_nemo, ONLY: ztraz => wrk_3d_2, zakz => wrk_3d_3, zwsink2 => wrk_3d_4 612 ! 613 613 INTEGER , INTENT(in ) :: jp_tra ! tracer index index 614 614 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pwsink ! sinking speed … … 617 617 INTEGER :: ji, jj, jk, jn 618 618 REAL(wp) :: zigma,zew,zign, zflx, zstep 619 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztraz, zakz 620 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwsink2 621 !!--------------------------------------------------------------------- 622 619 !!--------------------------------------------------------------------- 620 621 IF( wrk_in_use(3, 2,3,4 ) ) THEN 622 CALL ctl_stop('p4z_sink2: requested workspace arrays unavailable') 623 RETURN 624 END IF 623 625 624 626 zstep = rfact2 / 2. … … 701 703 END DO 702 704 703 trn(:,:,:,jp_tra) = trb(:,:,:,jp_tra) 704 psinkflx(:,:,:) = 2. * psinkflx(:,:,:) 705 705 trn (:,:,:,jp_tra) = trb(:,:,:,jp_tra) 706 psinkflx(:,:,:) = 2. * psinkflx(:,:,:) 707 ! 708 IF( wrk_not_released(3, 2,3,4) ) CALL ctl_stop('p4z_sink2: failed to release workspace arrays') 706 709 ! 707 710 END SUBROUTINE p4z_sink2 708 711 712 713 INTEGER FUNCTION p4z_sink_alloc() 714 !!---------------------------------------------------------------------- 715 !! *** ROUTINE p4z_sink_alloc *** 716 !!---------------------------------------------------------------------- 717 ALLOCATE( wsbio3 (jpi,jpj,jpk) , wsbio4 (jpi,jpj,jpk) , wscal(jpi,jpj,jpk) , & 718 & sinking(jpi,jpj,jpk) , sinking2(jpi,jpj,jpk) , & 719 & sinkcal(jpi,jpj,jpk) , sinksil (jpi,jpj,jpk) , & 720 #if defined key_kriest 721 & xnumm(jpk) , & 722 #else 723 & sinkfer2(jpi,jpj,jpk) , & 724 #endif 725 & sinkfer(jpi,jpj,jpk) , STAT=p4z_sink_alloc ) 726 ! 727 IF( p4z_sink_alloc /= 0 ) CALL ctl_warn('p4z_sink_alloc : failed to allocate arrays.') 728 ! 729 END FUNCTION p4z_sink_alloc 730 709 731 #else 710 732 !!====================================================================== -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90
r2528 r2715 7 7 !! 3.2 ! 2009-04 (C. Ethe & NEMO team) style 8 8 !!---------------------------------------------------------------------- 9 10 9 #if defined key_pisces 11 10 !!---------------------------------------------------------------------- … … 38 37 !!* Damping 39 38 LOGICAL :: ln_pisdmp !: relaxation or not of nutrients to a mean value 40 !: when initialize from a restart file41 39 LOGICAL :: ln_pisclo !: Restoring or not of nutrients to initial value 42 40 !: on close seas 43 41 44 42 !!* Biological fluxes for light 45 INTEGER , DIMENSION(jpi,jpj) ::neln !: number of T-levels + 1 in the euphotic layer46 REAL(wp), DIMENSION(jpi,jpj) ::heup !: euphotic layer depth43 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: neln !: number of T-levels + 1 in the euphotic layer 44 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: heup !: euphotic layer depth 47 45 48 46 !!* Biological fluxes for primary production 49 REAL(wp), DIMENSION(jpi,jpj):: xksi !: ???50 REAL(wp), DIMENSION(jpi,jpj):: xksimax !: ???51 REAL(wp), DIMENSION(jpi,jpj,jpk):: xnanono3 !: ???52 REAL(wp), DIMENSION(jpi,jpj,jpk):: xdiatno3 !: ???53 REAL(wp), DIMENSION(jpi,jpj,jpk):: xnanonh4 !: ???54 REAL(wp), DIMENSION(jpi,jpj,jpk):: xdiatnh4 !: ???55 REAL(wp), DIMENSION(jpi,jpj,jpk):: xlimphy !: ???56 REAL(wp), DIMENSION(jpi,jpj,jpk):: xlimdia !: ???57 REAL(wp), DIMENSION(jpi,jpj,jpk):: concdfe !: ???58 REAL(wp), DIMENSION(jpi,jpj,jpk):: concnfe !: ???47 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: xksi !: ??? 48 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: xksimax !: ??? 49 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnanono3 !: ??? 50 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xdiatno3 !: ??? 51 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnanonh4 !: ??? 52 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xdiatnh4 !: ??? 53 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimphy !: ??? 54 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimdia !: ??? 55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: concdfe !: ??? 56 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: concnfe !: ??? 59 57 60 58 !!* SMS for the organic matter 61 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xfracal !: ??62 REAL(wp), DIMENSION(jpi,jpj,jpk) :: nitrfac !: ??63 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xlimbac !: ??64 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xdiss !: ??59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xfracal !: ?? 60 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrfac !: ?? 61 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimbac !: ?? 62 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xdiss !: ?? 65 63 #if defined key_diatrc 66 REAL(wp), DIMENSION(jpi,jpj,jpk) :: prodcal !: Calcite production67 REAL(wp), DIMENSION(jpi,jpj,jpk) :: grazing !: Total zooplankton grazing64 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prodcal !: Calcite production 65 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: grazing !: Total zooplankton grazing 68 66 #endif 69 67 70 68 !!* Variable for chemistry of the CO2 cycle 71 REAL(wp), DIMENSION(jpi,jpj,jpk) :: akb3 !: ??? 72 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ak13 !: ??? 73 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ak23 !: ??? 74 REAL(wp), DIMENSION(jpi,jpj,jpk) :: aksp !: ??? 75 REAL(wp), DIMENSION(jpi,jpj,jpk) :: akw3 !: ??? 76 REAL(wp), DIMENSION(jpi,jpj,jpk) :: borat !: ??? 77 REAL(wp), DIMENSION(jpi,jpj,jpk) :: hi !: ??? 69 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akb3 !: ??? 70 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ak13 !: ??? 71 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ak23 !: ??? 72 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aksp !: ??? 73 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akw3 !: ??? 74 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: borat !: ??? 75 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hi !: ??? 76 77 !!* Array used to indicate negative tracer values 78 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnegtr !: ??? 78 79 79 80 #if defined key_kriest … … 85 86 #endif 86 87 88 !!---------------------------------------------------------------------- 89 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 90 !! $Id$ 91 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 92 !!---------------------------------------------------------------------- 93 CONTAINS 94 95 INTEGER FUNCTION sms_pisces_alloc() 96 !!---------------------------------------------------------------------- 97 !! *** ROUTINE sms_pisces_alloc *** 98 !!---------------------------------------------------------------------- 99 USE lib_mpp , ONLY: ctl_warn 100 INTEGER :: ierr(5) ! Local variables 101 !!---------------------------------------------------------------------- 102 ierr(:) = 0 103 ! 104 !* Biological fluxes for light 105 ALLOCATE( neln(jpi,jpj), heup(jpi,jpj), STAT=ierr(1) ) 106 ! 107 !* Biological fluxes for primary production 108 ALLOCATE( xksimax(jpi,jpj) , xksi(jpi,jpj) , & 109 & xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk), & 110 & xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk), & 111 & xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk), & 112 & concdfe (jpi,jpj,jpk), concnfe (jpi,jpj,jpk), STAT=ierr(2) ) 113 ! 114 !* SMS for the organic matter 115 ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac (jpi,jpj,jpk), & 116 #if defined key_diatrc 117 & prodcal(jpi,jpj,jpk) , grazing(jpi,jpj,jpk) , & 118 #endif 119 & xlimbac (jpi,jpj,jpk), xdiss(jpi,jpj,jpk) , STAT=ierr(3) ) 120 ! 121 !* Variable for chemistry of the CO2 cycle 122 ALLOCATE( akb3(jpi,jpj,jpk), ak13(jpi,jpj,jpk) , & 123 & ak23(jpi,jpj,jpk), aksp(jpi,jpj,jpk) , & 124 & akw3(jpi,jpj,jpk), borat(jpi,jpj,jpk), hi(jpi,jpj,jpk), STAT=ierr(4) ) 125 ! 126 !* Array used to indicate negative tracer values 127 ALLOCATE( xnegtr(jpi,jpj,jpk), STAT=ierr(5) ) 128 ! 129 sms_pisces_alloc = MAXVAL( ierr ) 130 ! 131 IF( sms_pisces_alloc /= 0 ) CALL ctl_warn('sms_pisces_alloc: failed to allocate arrays') 132 ! 133 END FUNCTION sms_pisces_alloc 134 87 135 #else 88 136 !!---------------------------------------------------------------------- … … 91 139 #endif 92 140 93 !!----------------------------------------------------------------------94 !! NEMO/TOP 3.3 , NEMO Consortium (2010)95 !! $Id$96 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)97 141 !!====================================================================== 98 142 END MODULE sms_pisces -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
r2528 r2715 21 21 USE oce_trc ! ocean variables 22 22 USE p4zche 23 USE lib_mpp 23 USE p4zche ! 24 USE p4zsink ! 25 USE p4zopt ! 26 USE p4zprod ! 27 USE p4zrem ! 28 USE p4zsed ! 29 USE p4zflx ! 24 30 25 31 IMPLICIT NONE … … 28 34 PUBLIC trc_ini_pisces ! called by trcini.F90 module 29 35 30 !! * Module variables 31 REAL(wp) :: & 32 sco2 = 2.312e-3 , & 33 alka0 = 2.423e-3 , & 34 oxyg0 = 177.6e-6 , & 35 po4 = 2.174e-6 , & 36 bioma0 = 1.000e-8 , & 37 silic1 = 91.65e-6 , & 38 no3 = 31.04e-6 * 7.6 36 REAL(wp) :: sco2 = 2.312e-3_wp 37 REAL(wp) :: alka0 = 2.423e-3_wp 38 REAL(wp) :: oxyg0 = 177.6e-6_wp 39 REAL(wp) :: po4 = 2.174e-6_wp 40 REAL(wp) :: bioma0 = 1.000e-8_wp 41 REAL(wp) :: silic1 = 91.65e-6_wp 42 REAL(wp) :: no3 = 31.04e-6_wp * 7.6_wp 39 43 40 44 # include "top_substitute.h90" … … 42 46 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 43 47 !! $Id$ 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 45 49 !!---------------------------------------------------------------------- 46 47 50 CONTAINS 48 51 … … 53 56 !! ** Purpose : Initialisation of the PISCES biochemical model 54 57 !!---------------------------------------------------------------------- 55 56 57 ! Control consitency 58 CALL trc_ctl_pisces 59 60 58 ! 61 59 IF(lwp) WRITE(numout,*) 62 60 IF(lwp) WRITE(numout,*) ' trc_ini_pisces : PISCES biochemical model initialisation' 63 61 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 62 63 CALL pisces_alloc() ! Allocate PISCES arrays 64 64 65 65 ! ! Time-step … … 126 126 IF(lwp) WRITE(numout,*) 'Initialization of PISCES tracers done' 127 127 IF(lwp) WRITE(numout,*) ' ' 128 129 128 ! 130 129 END SUBROUTINE trc_ini_pisces 131 132 SUBROUTINE trc_ctl_pisces 130 131 132 SUBROUTINE pisces_alloc 133 133 !!---------------------------------------------------------------------- 134 !! *** ROUTINE trc_ctl_pisces***134 !! *** ROUTINE pisces_alloc *** 135 135 !! 136 !! ** Purpose : control the cpp options, namelist and files136 !! ** Purpose : Allocate all the dynamic arrays of PISCES 137 137 !!---------------------------------------------------------------------- 138 USE p4zint , ONLY : p4z_int_alloc 139 USE p4zsink, ONLY : p4z_sink_alloc 140 USE p4zopt , ONLY : p4z_opt_alloc 141 USE p4zprod, ONLY : p4z_prod_alloc 142 USE p4zrem , ONLY : p4z_rem_alloc 143 USE p4zsed , ONLY : p4z_sed_alloc 144 USE p4zflx , ONLY : p4z_flx_alloc 145 ! 146 INTEGER :: ierr 147 !!---------------------------------------------------------------------- 148 ! 149 ierr = sms_pisces_alloc() ! Start of PISCES-related alloc routines... 150 ierr = ierr + p4z_che_alloc() 151 ierr = ierr + p4z_int_alloc() 152 ierr = ierr + p4z_sink_alloc() 153 ierr = ierr + p4z_opt_alloc() 154 ierr = ierr + p4z_prod_alloc() 155 ierr = ierr + p4z_rem_alloc() 156 ierr = ierr + p4z_sed_alloc() 157 ierr = ierr + p4z_flx_alloc() 158 ! 159 IF( lk_mpp ) CALL mpp_sum( ierr ) 160 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'pisces_alloc: unable to allocate PISCES arrays' ) 161 ! 162 END SUBROUTINE pisces_alloc 138 163 139 IF(lwp) WRITE(numout,*)140 IF(lwp) WRITE(numout,*) ' use PISCES biological model '141 142 ! Check number of tracers143 ! -----------------------144 #if defined key_kriest145 IF( jp_pisces /= 23) CALL ctl_stop( ' PISCES must have 23 passive tracers. Change jp_pisces in par_pisces.F90' )146 #else147 IF( jp_pisces /= 24) CALL ctl_stop( ' PISCES must have 24 passive tracers. Change jp_pisces in par_pisces.F90' )148 #endif149 150 END SUBROUTINE trc_ctl_pisces151 152 164 #else 153 165 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90
r2567 r2715 19 19 USE trc ! TOP variables 20 20 USE sms_pisces ! sms trends 21 USE in_out_manager ! I/O manager22 21 23 22 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90
r2528 r2715 18 18 USE trcsms_pisces ! pisces sms trends 19 19 USE sms_pisces ! pisces sms variables 20 USE in_out_manager ! I/O manager21 20 USE iom 22 21 USE trcdta 23 USE lib_mpp24 USE lib_fortran25 22 26 23 IMPLICIT NONE … … 108 105 !! ** purpose : Relaxation of some tracers 109 106 !!---------------------------------------------------------------------- 110 INTEGER :: ji, jj, jk 111 REAL(wp) :: & 112 alkmean = 2426. , & ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 113 po4mean = 2.165 , & ! mean value of phosphates 114 no3mean = 30.90 , & ! mean value of nitrate 115 silmean = 91.51 ! mean value of silicate 116 117 REAL(wp) :: zarea, zvol, zalksum, zpo4sum, zno3sum, zsilsum 107 REAL(wp) :: alkmean = 2426. ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 108 REAL(wp) :: po4mean = 2.165 ! mean value of phosphates 109 REAL(wp) :: no3mean = 30.90 ! mean value of nitrate 110 REAL(wp) :: silmean = 91.51 ! mean value of silicate 111 112 REAL(wp) :: zarea, zalksum, zpo4sum, zno3sum, zsilsum 118 113 119 114 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90
r2528 r2715 16 16 USE trc 17 17 USE sms_pisces 18 USE lbclnk19 USE lib_mpp20 18 21 19 USE p4zint ! … … 65 63 !! - ... 66 64 !!--------------------------------------------------------------------- 65 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 66 USE wrk_nemo, ONLY: ztrpis => wrk_3d_1 ! used for pisces sms trends 67 ! 67 68 INTEGER, INTENT( in ) :: kt ! ocean time-step index 68 69 !! 69 70 INTEGER :: jnt, jn 70 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrpis ! used for pisces sms trends71 71 CHARACTER (len=25) :: charout 72 72 !!--------------------------------------------------------------------- 73 73 74 74 IF( kt == nit000 ) CALL trc_sms_pisces_init ! Initialization (first time-step only) 75 76 IF( wrk_in_use(3,1) ) THEN 77 CALL ctl_stop('trc_sms_pisces : requested workspace array unavailable.') ; RETURN 78 ENDIF 75 79 76 80 IF( ndayflxtr /= nday_year ) THEN ! New days … … 111 115 CALL trd_mod_trc( ztrpis, jn, jptra_trd_sms, kt ) ! save trends 112 116 END DO 117 DEALLOCATE( ztrpis ) 113 118 END IF 114 119 … … 122 127 ! 123 128 ENDIF 129 130 IF( wrk_not_released(3,1) ) CALL ctl_stop('trc_sms_pisces : failed to release workspace array.') 124 131 125 132 END SUBROUTINE trc_sms_pisces -
trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedini.F90
r2528 r2715 17 17 USE sedarr 18 18 USE iom 19 USE in_out_manager ! I/O manager20 19 21 20 -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r2528 r2715 10 10 !!---------------------------------------------------------------------- 11 11 !! 'key_top' TOP models 12 !!----------------------------------------------------------------------13 12 !!---------------------------------------------------------------------- 14 13 !! trc_adv : compute ocean tracer advection trend … … 26 25 USE traadv_eiv ! eddy induced velocity (tra_adv_eiv routine) 27 26 USE ldftra_oce ! lateral diffusion coefficient on tracers 28 USE in_out_manager ! I/O manager 29 USE prtctl_trc ! Print control 27 USE prtctl_trc ! Print control 30 28 31 29 IMPLICIT NONE 32 30 PRIVATE 33 31 34 PUBLIC trc_adv ! routine called by step module 32 PUBLIC trc_adv ! routine called by step module 33 PUBLIC trc_adv_alloc ! routine called by nemogcm module 35 34 36 35 INTEGER :: nadv ! choice of the type of advection scheme 37 REAL(wp), DIMENSION(jpk) :: r2dt ! vertical profile time-step, = 2 rdttra38 !! except at nit000 (=rdttra) if neuler=036 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra 37 ! ! except at nit000 (=rdttra) if neuler=0 39 38 40 39 !! * Substitutions … … 46 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 47 46 !!---------------------------------------------------------------------- 48 49 47 CONTAINS 48 49 INTEGER FUNCTION trc_adv_alloc() 50 !!---------------------------------------------------------------------- 51 !! *** ROUTINE trc_adv_alloc *** 52 !!---------------------------------------------------------------------- 53 54 ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc ) 55 56 IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.') 57 58 END FUNCTION trc_adv_alloc 59 50 60 51 61 SUBROUTINE trc_adv( kt ) … … 57 67 !! ** Method : - Update the tracer with the advection term following nadv 58 68 !!---------------------------------------------------------------------- 69 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 70 USE wrk_nemo, ONLY: zun => wrk_3d_4, zvn => wrk_3d_5, zwn => wrk_3d_6 ! effective velocity 59 71 !! 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index 61 ! 62 INTEGER :: jk 63 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zun, zvn, zwn ! effective velocity 64 CHARACTER (len=22) :: charout 65 !!---------------------------------------------------------------------- 72 INTEGER, INTENT(in) :: kt ! ocean time-step index 73 ! 74 INTEGER :: jk 75 CHARACTER (len=22) :: charout 76 !!---------------------------------------------------------------------- 77 ! 78 IF( wrk_in_use(3, 4,5,6) ) THEN 79 CALL ctl_stop('trc_adv : requested workspace arrays unavailable') ; RETURN 80 ENDIF 66 81 67 82 IF( kt == nit000 ) CALL trc_adv_ctl ! initialisation & control of options … … 80 95 DO jk = 1, jpkm1 81 96 ! ! eulerian transport only 82 zun(:,:,jk) = e2u (:,:) * fse3u(:,:,jk) * un(:,:,jk)83 zvn(:,:,jk) = e1v (:,:) * fse3v(:,:,jk) * vn(:,:,jk)84 zwn(:,:,jk) = e1 t(:,:) * e2t(:,:)* wn(:,:,jk)97 zun(:,:,jk) = e2u (:,:) * fse3u(:,:,jk) * un(:,:,jk) 98 zvn(:,:,jk) = e1v (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 99 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 85 100 ! 86 101 END DO … … 125 140 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 126 141 END IF 142 ! 143 IF( wrk_not_released(3, 4,5,6) ) CALL ctl_stop('trc_adv : failed to release workspace arrays.') 127 144 ! 128 145 END SUBROUTINE trc_adv … … 171 188 ! 172 189 END SUBROUTINE trc_adv_ctl 190 173 191 #else 174 192 !!---------------------------------------------------------------------- … … 181 199 END SUBROUTINE trc_adv 182 200 #endif 201 183 202 !!====================================================================== 184 203 END MODULE trcadv -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r2528 r2715 29 29 PRIVATE 30 30 31 PUBLIC trc_dmp ! routine called by step.F90 31 PUBLIC trc_dmp ! routine called by step.F90 32 PUBLIC trc_dmp_alloc ! routine called by nemogcm.F90 32 33 33 34 LOGICAL , PUBLIC, PARAMETER :: lk_trcdmp = .TRUE. !: internal damping flag 34 ! !!* Namelist namtrc_dmp : passive tracer newtonian damping * 35 36 ! !!* Namelist namtrc_dmp : passive tracer newtonian damping * 35 37 INTEGER :: nn_hdmp_tr = -1 ! = 0/-1/'latitude' for damping over passive tracer 36 38 INTEGER :: nn_zdmp_tr = 0 ! = 0/1/2 flag for damping in the mixed layer … … 40 42 INTEGER :: nn_file_tr = 2 ! = 1 create a damping.coeff NetCDF file 41 43 42 REAL(wp), DIMENSION(jpi,jpj,jpk) :: restotr ! restoring coeff. on tracers (s-1)44 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: restotr ! restoring coeff. on tracers (s-1) 43 45 44 46 !! * Substitutions … … 47 49 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 48 50 !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcdmp.F90,v 1.11 2006/09/01 14:03:49 opalod Exp $ 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 !!---------------------------------------------------------------------- 51 51 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 52 !!---------------------------------------------------------------------- 52 53 CONTAINS 54 55 INTEGER FUNCTION trc_dmp_alloc() 56 !!---------------------------------------------------------------------- 57 !! *** ROUTINE trc_dmp_alloc *** 58 !!---------------------------------------------------------------------- 59 ALLOCATE( restotr(jpi,jpj,jpk) , STAT=trc_dmp_alloc ) 60 ! 61 IF( trc_dmp_alloc /= 0 ) CALL ctl_warn('trc_dmp_alloc: failed to allocate array') 62 ! 63 END FUNCTION trc_dmp_alloc 64 53 65 54 66 SUBROUTINE trc_dmp( kt ) … … 161 173 !! 162 174 !! ** Method : read the nammbf namelist and check the parameters 163 !! called by trc_dmp at the first timestep (nit000)175 !! called by trc_dmp at the first timestep (nit000) 164 176 !!---------------------------------------------------------------------- 165 177 -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r2528 r2715 27 27 USE trdtra 28 28 USE prtctl_trc ! Print control 29 USE in_out_manager ! I/O manager30 USE lib_mpp ! distribued memory computing library31 USE lbclnk ! ocean lateral boundary conditions (or mpp link)32 29 33 30 IMPLICIT NONE -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r2528 r2715 3 3 !! *** MODULE trcnxt *** 4 4 !! Ocean passive tracers: time stepping on passives tracers 5 !!======================================================================6 5 !!====================================================================== 7 6 !! History : 7.0 ! 1991-11 (G. Madec) Original code … … 27 26 !! trc_nxt : time stepping on passive tracers 28 27 !!---------------------------------------------------------------------- 29 !! * Modules used30 28 USE oce_trc ! ocean dynamics and tracers variables 31 29 USE trc ! ocean passive tracers variables … … 43 41 PRIVATE 44 42 45 !! * Routine accessibility46 PUBLIC trc_nxt ! routine called by step.F9043 PUBLIC trc_nxt ! routine called by step.F90 44 PUBLIC trc_nxt_alloc ! routine called by nemogcm.F90 47 45 48 REAL(wp), DIMENSION(jpk) :: r2dt 46 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt 47 49 48 !!---------------------------------------------------------------------- 50 49 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 51 50 !! $Id$ 52 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)51 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 53 52 !!---------------------------------------------------------------------- 53 CONTAINS 54 54 55 CONTAINS 55 INTEGER FUNCTION trc_nxt_alloc() 56 !!---------------------------------------------------------------------- 57 !! *** ROUTINE trc_nxt_alloc *** 58 !!---------------------------------------------------------------------- 59 ALLOCATE( r2dt(jpk), STAT=trc_nxt_alloc ) 60 ! 61 IF( trc_nxt_alloc /= 0 ) CALL ctl_warn('trc_nxt_alloc : failed to allocate array') 62 ! 63 END FUNCTION trc_nxt_alloc 64 56 65 57 66 SUBROUTINE trc_nxt( kt ) … … 79 88 !! ** Action : - update trb, trn 80 89 !!---------------------------------------------------------------------- 81 !! * Arguments82 90 INTEGER, INTENT( in ) :: kt ! ocean time-step index 83 ! ! * Local declarations91 ! 84 92 INTEGER :: jk, jn ! dummy loop indices 85 93 REAL(wp) :: zfact ! temporary scalar -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r2528 r2715 17 17 USE trdmod_oce 18 18 USE trdtra 19 USE lib_mpp20 19 USE prtctl_trc ! Print control for debbuging 21 20 -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r2528 r2715 16 16 !! trc_sbc : update the tracer trend at ocean surface 17 17 !!---------------------------------------------------------------------- 18 !! * Modules used 19 USE oce_trc ! ocean dynamics and active tracers variables 20 USE trc ! ocean passive tracers variables 21 USE prtctl_trc ! Print control for debbuging 18 USE oce_trc ! ocean dynamics and active tracers variables 19 USE trc ! ocean passive tracers variables 20 USE prtctl_trc ! Print control for debbuging 22 21 USE trdmod_oce 23 22 USE trdtra … … 26 25 PRIVATE 27 26 28 !! * Routine accessibility 29 PUBLIC trc_sbc ! routine called by step.F90 27 PUBLIC trc_sbc ! routine called by step.F90 30 28 31 29 !! * Substitutions … … 34 32 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 35 33 !! $Id$ 36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 37 35 !!---------------------------------------------------------------------- 38 39 36 CONTAINS 40 37 … … 60 57 !! 61 58 !!---------------------------------------------------------------------- 62 !! * Arguments 59 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 60 USE wrk_nemo, ONLY: zemps => wrk_2d_1 61 USE wrk_nemo, ONLY: ztrtrd => wrk_3d_1 62 ! 63 63 INTEGER, INTENT( in ) :: kt ! ocean time-step index 64 65 !! * Local declarations 64 ! 66 65 INTEGER :: ji, jj, jn ! dummy loop indices 67 66 REAL(wp) :: zsrau, zse3t ! temporary scalars 68 REAL(wp), DIMENSION(jpi,jpj) :: zemps ! surface freshwater flux69 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrtrd70 67 CHARACTER (len=22) :: charout 71 68 !!---------------------------------------------------------------------- 69 70 IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1) ) THEN 71 CALL ctl_stop('trc_sbc: requested workspace array unavailable.') ; RETURN 72 END IF 72 73 73 74 IF( kt == nit000 ) THEN … … 77 78 ENDIF 78 79 79 80 IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) )81 80 82 81 IF( lk_offline ) THEN ! emps in dynamical files contains emps - rnf … … 113 112 END DO ! tracer loop 114 113 ! ! =========== 115 IF( l_trdtrc ) DEALLOCATE( ztrtrd )116 117 114 IF( ln_ctl ) THEN 118 115 WRITE(charout, FMT="('sbc ')") ; CALL prt_ctl_trc_info(charout) 119 116 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 120 117 ENDIF 118 119 IF( wrk_not_released(2, 1) .OR. wrk_not_released(3, 1) ) & 120 & CALL ctl_stop('trc_sbc: failed to release workspace array.') 121 121 122 122 END SUBROUTINE trc_sbc -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r2528 r2715 11 11 !! 'key_top' TOP models 12 12 !!---------------------------------------------------------------------- 13 !!----------------------------------------------------------------------14 13 !! trc_ldf : update the tracer trend with the lateral diffusion 15 14 !! ldf_ctl : initialization, namelist read, and parameters control … … 20 19 USE trazdf_exp ! vertical diffusion: explicit (tra_zdf_exp routine) 21 20 USE trazdf_imp ! vertical diffusion: implicit (tra_zdf_imp routine) 22 USE prtctl_trc ! Print control23 USE in_out_manager ! I/O manager24 USE lbclnk ! ocean lateral boundary conditions (or mpp link)25 21 USE trdmod_oce 26 22 USE trdtra 23 USE prtctl_trc ! Print control 27 24 28 25 IMPLICIT NONE 29 26 PRIVATE 30 27 31 PUBLIC trc_zdf ! called by step.F90 28 PUBLIC trc_zdf ! called by step.F90 29 PUBLIC trc_zdf_alloc ! called by nemogcm.F90 32 30 33 31 INTEGER :: nzdf = 0 ! type vertical diffusion algorithm used 34 32 ! ! defined from ln_zdf... namlist logicals) 35 REAL(wp), DIMENSION(jpk) :: r2dt ! vertical profile time-step, = 2 rdttra36 ! ! except at nit000 (=rdttra) if neuler=033 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra 34 ! ! except at nit000 (=rdttra) if neuler=0 37 35 38 36 !! * Substitutions … … 43 41 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 44 42 !! $Id$ 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)43 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 46 44 !!---------------------------------------------------------------------- 47 48 45 CONTAINS 49 46 47 INTEGER FUNCTION trc_zdf_alloc() 48 !!---------------------------------------------------------------------- 49 !! *** ROUTINE trc_zdf_alloc *** 50 !!---------------------------------------------------------------------- 51 ALLOCATE( r2dt(jpk) , STAT=trc_zdf_alloc ) 52 ! 53 IF( trc_zdf_alloc /= 0 ) CALL ctl_warn('trc_zdf_alloc : failed to allocate array.') 54 ! 55 END FUNCTION trc_zdf_alloc 56 57 50 58 SUBROUTINE trc_zdf( kt ) 51 59 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc.F90
r2528 r2715 23 23 USE zdfddm , ONLY : avs !: salinity vertical diffusivity coeff. at w-point 24 24 # endif 25 USE trcnam_trp ! passive tracers transport namelist variables25 USE trcnam_trp ! passive tracers transport namelist variables 26 26 USE trdmod_trc_oce ! definition of main arrays used for trends computations 27 27 USE in_out_manager ! I/O manager … … 30 30 USE ioipsl ! NetCDF library 31 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 32 USE lib_mpp ! MPP library 32 33 USE trdmld_trc_rst ! restart for diagnosing the ML trends 33 34 USE prtctl ! print control … … 39 40 40 41 PUBLIC trd_mld_trc 42 PUBLIC trd_mld_trc_alloc 41 43 PUBLIC trd_mld_bio 42 44 PUBLIC trd_mld_trc_init … … 46 48 CHARACTER (LEN=40) :: clhstnam ! name of the trends NetCDF file 47 49 INTEGER :: nmoymltrd 48 INTEGER :: ndextrd1(jpi*jpj)50 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndextrd1 49 51 INTEGER, DIMENSION(jptra) :: nidtrd, nh_t 50 52 INTEGER :: ndimtrd1 … … 58 60 LOGICAL :: lldebug = .TRUE. 59 61 62 ! Workspace array for trd_mld_trc() routine. Declared here as is 4D and 63 ! cannot use workspaces in wrk_nemo module. 64 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: ztmltrd2 ! 65 #if defined key_lobster 66 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ztmltrdbio2 ! only needed for mean diagnostics in trd_mld_bio() 67 #endif 68 60 69 !! * Substitutions 61 70 # include "top_substitute.h90" … … 63 72 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 64 73 !! $Header: $ 65 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)74 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 66 75 !!---------------------------------------------------------------------- 67 68 76 CONTAINS 77 78 INTEGER FUNCTION trd_mld_trc_alloc() 79 !!---------------------------------------------------------------------- 80 !! *** ROUTINE trd_mld_trc_alloc *** 81 !!---------------------------------------------------------------------- 82 ALLOCATE( ztmltrd2(jpi,jpj,jpltrd_trc,jptra) , & 83 #if defined key_lobster 84 & ztmltrdbio2(jpi,jpj,jpdiabio) , & 85 #endif 86 & ndextrd1(jpi*jpj) , STAT=trd_mld_trc_alloc) 87 ! 88 IF( lk_mpp ) CALL mpp_sum ( trd_mld_trc_alloc ) 89 IF( trd_mld_trc_alloc /=0 ) CALL ctl_warn('trd_mld_trc_alloc: failed to allocate arrays') 90 ! 91 END FUNCTION trd_mld_trc_alloc 92 69 93 70 94 SUBROUTINE trd_mld_trc_zint( ptrc_trdmld, ktrd, ctype, kjn ) … … 88 112 !! surface and the control surface is called "mixed-layer" 89 113 !!---------------------------------------------------------------------- 114 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 115 USE wrk_nemo, ONLY: zvlmsk => wrk_2d_1 116 !! 90 117 INTEGER, INTENT( in ) :: ktrd, kjn ! ocean trend index and passive tracer rank 91 118 CHARACTER(len=2), INTENT( in ) :: ctype ! surface/bottom (2D) or interior (3D) physics 92 119 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: ptrc_trdmld ! passive tracer trend 93 120 INTEGER :: ji, jj, jk, isum 94 REAL(wp), DIMENSION(jpi,jpj) :: zvlmsk 95 !!---------------------------------------------------------------------- 121 !!---------------------------------------------------------------------- 122 123 IF( wrk_in_use(2, 1) ) THEN 124 CALL ctl_stop('trd_mld_trc_zint: requested workspace array unavailable') ; RETURN 125 ENDIF 96 126 97 127 ! I. Definition of control surface and integration weights … … 177 207 tmltrd_trc(:,:,ktrd,kjn) = tmltrd_trc(:,:,ktrd,kjn) + ptrc_trdmld(:,:,1) * wkx_trc(:,:,1) ! non penetrative 178 208 END SELECT 179 180 END SUBROUTINE trd_mld_trc_zint 181 182 SUBROUTINE trd_mld_bio_zint( ptrc_trdmld, ktrd ) 209 ! 210 IF( wrk_not_released(2, 1) ) CALL ctl_stop('trd_mld_trc_zint: failed to release workspace array') 211 ! 212 END SUBROUTINE trd_mld_trc_zint 213 214 215 SUBROUTINE trd_mld_bio_zint( ptrc_trdmld, ktrd ) 183 216 !!---------------------------------------------------------------------- 184 217 !! *** ROUTINE trd_mld_bio_zint *** … … 198 231 !! surface and the control surface is called "mixed-layer" 199 232 !!---------------------------------------------------------------------- 200 INTEGER, INTENT( in ) :: ktrd ! bio trend index 201 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: ptrc_trdmld ! passive trc trend 233 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 234 USE wrk_nemo, ONLY: zvlmsk => wrk_2d_1 235 !! 236 INTEGER , INTENT(in) :: ktrd ! bio trend index 237 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: ptrc_trdmld ! passive trc trend 202 238 #if defined key_lobster 203 ! ! local variables239 ! 204 240 INTEGER :: ji, jj, jk, isum 205 REAL(wp), DIMENSION(jpi,jpj) :: zvlmsk 206 !!---------------------------------------------------------------------- 241 !!---------------------------------------------------------------------- 242 243 IF( wrk_in_use(2, 1) ) THEN 244 CALL ctl_stop('trd_mld_bio_zint: requested workspace array unavailable') ; RETURN 245 ENDIF 207 246 208 247 ! I. Definition of control surface and integration weights … … 286 325 END DO 287 326 288 #endif 289 290 END SUBROUTINE trd_mld_bio_zint 291 292 293 SUBROUTINE trd_mld_trc( kt ) 327 IF( wrk_not_released(2, 1) ) CALL ctl_stop('trd_mld_bio_zint: failed to release workspace array') 328 #endif 329 ! 330 END SUBROUTINE trd_mld_bio_zint 331 332 333 SUBROUTINE trd_mld_trc( kt ) 294 334 !!---------------------------------------------------------------------- 295 335 !! *** ROUTINE trd_mld_trc *** … … 338 378 !! - See NEMO documentation (in preparation) 339 379 !!---------------------------------------------------------------------- 340 INTEGER, INTENT( in ) :: kt ! ocean time-step index 380 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 381 USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2, wrk_3d_3, wrk_3d_4 382 USE wrk_nemo, ONLY: wrk_3d_5, wrk_3d_6, wrk_3d_7, wrk_3d_8, wrk_3d_9 383 ! 384 INTEGER, INTENT(in) :: kt ! ocean time-step index 385 ! 341 386 INTEGER :: ji, jj, jk, jl, ik, it, itmod, jn 342 387 REAL(wp) :: zavt, zfn, zfn2 343 ! !344 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmltot ! d(trc)/dt over the anlysis window (incl. Asselin)345 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmlres ! residual = dh/dt entrainment term346 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmlatf ! for storage only347 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmlrad ! for storage only (for trb<0 corr in trcrad)348 ! !349 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmltot2 ! -+350 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmlres2 ! | working arrays to diagnose the trends351 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmltrdm2 ! | associated with the time meaned ML352 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmlatf2 ! | passive tracers353 REAL(wp), DIMENSION(jpi,jpj,jptra) :: ztmlrad2 ! | (-> for trb<0 corr in trcrad)354 REAL(wp), DIMENSION(jpi,jpj,jpltrd_trc,jptra) :: ztmltrd2 ! -+355 ! !388 ! 389 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmltot ! d(trc)/dt over the anlysis window (incl. Asselin) 390 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmlres ! residual = dh/dt entrainment term 391 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmlatf ! for storage only 392 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmlrad ! for storage only (for trb<0 corr in trcrad) 393 ! 394 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmltot2 ! -+ 395 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmlres2 ! | working arrays to diagnose the trends 396 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmltrdm2 ! | associated with the time meaned ML 397 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmlatf2 ! | passive tracers 398 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmlrad2 ! | (-> for trb<0 corr in trcrad) 399 !REAL(wp), DIMENSION(jpi,jpj,jpltrd_trc,jptra) :: ztmltrd2 ! -+ 400 ! 356 401 CHARACTER (LEN= 5) :: clvar 357 402 #if defined key_dimgout … … 361 406 !!---------------------------------------------------------------------- 362 407 363 IF( nn_dttrc /= 1 ) CALL ctl_stop( " Be careful, trends diags never validated " ) 408 IF( wrk_in_use(3, 1,2,3,4,5,6,7,8,9) ) THEN 409 CALL ctl_stop('trd_mld_trc : requested workspace arrays unavailable') ; RETURN 410 ENDIF 411 ! Set-up pointers into sub-arrays of workspaces 412 ztmltot => wrk_3d_1(:,:,1:jptra) 413 ztmlres => wrk_3d_2(:,:,1:jptra) 414 ztmlatf => wrk_3d_3(:,:,1:jptra) 415 ztmlrad => wrk_3d_4(:,:,1:jptra) 416 ztmltot2 => wrk_3d_5(:,:,1:jptra) 417 ztmlres2 => wrk_3d_6(:,:,1:jptra) 418 ztmltrdm2 => wrk_3d_7(:,:,1:jptra) 419 ztmlatf2 => wrk_3d_8(:,:,1:jptra) 420 ztmlrad2 => wrk_3d_9(:,:,1:jptra) 421 422 423 IF( nn_dttrc /= 1 ) CALL ctl_stop( " Be careful, trends diags never validated " ) 364 424 365 425 ! ====================================================================== … … 386 446 387 447 DO jn = 1, jptra 388 ! ... Remove this K_z trend from the iso-neutral diffusion term (if any)448 ! ... Remove this K_z trend from the iso-neutral diffusion term (if any) 389 449 IF( ln_trdtrc(jn) ) & 390 450 tmltrd_trc(:,:,jpmld_trc_ldf,jn) = tmltrd_trc(:,:,jpmld_trc_ldf,jn) - tmltrd_trc(:,:,jpmld_trc_zdf,jn) … … 847 907 IF( lrst_trc ) CALL trd_mld_trc_rst_write( kt ) ! this must be after the array swap above (III.3) 848 908 909 IF( wrk_not_released(3, 1,2,3,4,5,6,7,8,9) ) CALL ctl_stop('trd_mld_trc: failed to release workspace arrays') 910 ! 849 911 END SUBROUTINE trd_mld_trc 850 912 851 SUBROUTINE trd_mld_bio( kt ) 913 914 SUBROUTINE trd_mld_bio( kt ) 852 915 !!---------------------------------------------------------------------- 853 916 !! *** ROUTINE trd_mld *** … … 900 963 INTEGER :: jl, it, itmod 901 964 LOGICAL :: llwarn = .TRUE., lldebug = .TRUE. 902 REAL(wp), DIMENSION(jpi,jpj,jpdiabio) :: ztmltrdbio2 ! only needed for mean diagnostics903 965 REAL(wp) :: zfn, zfn2 904 966 #if defined key_dimgout … … 1085 1147 END SUBROUTINE trd_mld_bio 1086 1148 1149 1087 1150 REAL FUNCTION sum2d( ztab ) 1088 1151 !!---------------------------------------------------------------------- … … 1091 1154 REAL(wp), DIMENSION(jpi,jpj), INTENT( in ) :: ztab 1092 1155 !!---------------------------------------------------------------------- 1093 sum2d = SUM( ztab(2:jpi-1,2:jpj-1))1156 sum2d = SUM( ztab(2:jpi-1,2:jpj-1) ) 1094 1157 END FUNCTION sum2d 1158 1095 1159 1096 1160 SUBROUTINE trd_mld_trc_init … … 1378 1442 !! Default option : Empty module 1379 1443 !!---------------------------------------------------------------------- 1380 1381 1444 CONTAINS 1382 1383 1445 SUBROUTINE trd_mld_trc( kt ) ! Empty routine 1384 1446 INTEGER, INTENT( in) :: kt 1385 1447 WRITE(*,*) 'trd_mld_trc: You should not have seen this print! error?', kt 1386 1448 END SUBROUTINE trd_mld_trc 1387 1388 1449 SUBROUTINE trd_mld_bio( kt ) 1389 1450 INTEGER, INTENT( in) :: kt 1390 1451 WRITE(*,*) 'trd_mld_bio: You should not have seen this print! error?', kt 1391 1452 END SUBROUTINE trd_mld_bio 1392 1393 1453 SUBROUTINE trd_mld_trc_zint( ptrc_trdmld, ktrd, ctype, kjn ) 1394 1454 INTEGER , INTENT( in ) :: ktrd, kjn ! ocean trend index and passive tracer rank … … 1400 1460 WRITE(*,*) ' " " : You should not have seen this print! error?', kjn 1401 1461 END SUBROUTINE trd_mld_trc_zint 1402 1403 1462 SUBROUTINE trd_mld_trc_init ! Empty routine 1404 1463 WRITE(*,*) 'trd_mld_trc_init: You should not have seen this print! error?' -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc_oce.F90
r2528 r2715 4 4 !! Ocean trends : set tracer and momentum trend variables 5 5 !!====================================================================== 6 !!---------------------------------------------------------------------- 7 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 8 !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmld_oce.F90,v 1.2 2005/03/27 18:35:23 opalod Exp $ 9 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 10 !!---------------------------------------------------------------------- 11 #if defined key_top 6 #if defined key_top || defined key_esopa 12 7 !!---------------------------------------------------------------------- 13 8 !! 'key_top' TOP models 14 9 !!---------------------------------------------------------------------- 15 16 USE par_oce ! ocean parameters 17 USE par_trc ! passive tracers parameters 10 USE par_oce ! ocean parameters 11 USE par_trc ! passive tracers parameters 18 12 19 13 IMPLICIT NONE 20 14 PUBLIC 21 15 22 ! !* Namelist namtoptrd: diagnostics on passive tracers trends23 INTEGER :: nn_trd_trc !: time step frequency dynamics and tracers trends24 INTEGER :: nn_ctls_trc !: control surface type for trends vertical integration16 ! !!* Namelist namtoptrd: diagnostics on passive tracers trends 17 INTEGER :: nn_trd_trc !: time step frequency dynamics and tracers trends 18 INTEGER :: nn_ctls_trc !: control surface type for trends vertical integration 25 19 REAL(wp) :: rn_ucf_trc !: unit conversion factor (for netCDF trends outputs) 26 LOGICAL :: ln_trdmld_trc_instant !: flag to diagnose inst./mean ML trc trends27 LOGICAL :: ln_trdmld_trc_restart !: flag to restart mixed-layer trc diagnostics28 CHARACTER(len=50) :: cn_trdrst_trc_in !: suffix of pass. tracer restart name (input)29 CHARACTER(len=50) :: cn_trdrst_trc_out !: suffix of pass. tracer restart name (output)30 LOGICAL, DIMENSION (jptra) :: ln_trdtrc!: large trends diagnostic to write or not (namelist)20 LOGICAL :: ln_trdmld_trc_instant !: flag to diagnose inst./mean ML trc trends 21 LOGICAL :: ln_trdmld_trc_restart !: flag to restart mixed-layer trc diagnostics 22 CHARACTER(len=50) :: cn_trdrst_trc_in !: suffix of pass. tracer restart name (input) 23 CHARACTER(len=50) :: cn_trdrst_trc_out !: suffix of pass. tracer restart name (output) 24 LOGICAL, DIMENSION(jptra) :: ln_trdtrc !: large trends diagnostic to write or not (namelist) 31 25 32 26 # if defined key_trdtrc && defined key_iomput 33 27 LOGICAL, PARAMETER :: lk_trdtrc = .TRUE. 34 # else28 # else 35 29 LOGICAL, PARAMETER :: lk_trdtrc = .FALSE. !: ML trend flag 36 # endif30 # endif 37 31 38 # if defined key_trdmld_trc32 # if defined key_trdmld_trc || defined key_esopa 39 33 !!---------------------------------------------------------------------- 40 34 !! 'key_trdmld_trc' mixed layer trends diagnostics … … 60 54 !! Trends diagnostics parameters 61 55 !!--------------------------------------------------------------------- 62 INTEGER, PARAMETER :: &63 jpltrd_trc = 12, & !: number of mixed-layer trends arrays64 jpktrd_trc = jpk!: max level for mixed-layer trends diag.56 INTEGER, PARAMETER :: jpltrd_trc = 12 !: number of mixed-layer trends arrays 57 58 INTEGER :: jpktrd_trc !: max level for mixed-layer trends diag. 65 59 66 60 !! Arrays used for diagnosing mixed-layer trends … … 68 62 CHARACTER(LEN=80) :: clname_trc, ctrd_trc(jpltrd_trc+1,2) 69 63 70 INTEGER, DIMENSION(jpi,jpj) :: &64 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:,:) :: & 71 65 nmld_trc , & !: mixed layer depth indexes 72 66 nbol_trc !: mixed-layer depth indexes when read from file 73 67 74 REAL(wp), DIMENSION(jpi,jpj,jpk) :: wkx_trc !:68 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wkx_trc !: 75 69 76 REAL(wp), DIMENSION(jpi,jpj) :: rmld_trc !: ML depth (m) corresponding to nmld_trc77 REAL(wp), DIMENSION(jpi,jpj) :: rmld_sum_trc !: needed to compute the leap-frog time mean of ML depth78 REAL(wp), DIMENSION(jpi,jpj) :: rmldbn_trc !: idem70 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: rmld_trc !: ML depth (m) corresponding to nmld_trc 71 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: rmld_sum_trc !: needed to compute the leap-frog time mean of ML depth 72 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: rmldbn_trc !: idem 79 73 80 REAL(wp), DIMENSION(jpi,jpj,jptra) :: &74 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: & 81 75 tml_trc , & !: \ "now" mixed layer temperature/salinity 82 76 tmlb_trc , & !: / and associated "before" fields … … 89 83 !: previous analysis period 90 84 91 REAL(wp), DIMENSION(jpi,jpj,jptra) :: &85 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: & 92 86 tmlatfb_trc, tmlatfn_trc , & !: "before" Asselin contrib. at beginning of the averaging 93 87 !: period (i.e. last contrib. from previous such period) … … 98 92 tmlradm_trc !: accumulator for the previous trcrad trend 99 93 100 REAL(wp), DIMENSION(jpi,jpj,jpltrd_trc,jptra) :: &94 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: & 101 95 tmltrd_trc, & !: \ physical contributions to the total trend (for T/S), 102 96 !: / cumulated over the current analysis window … … 105 99 tmltrd_csum_ub_trc !: before (prev. analysis period) cumulated sum over the 106 100 !: upper triangle 107 REAL(wp), DIMENSION(jpi,jpj,jptra) :: &101 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: & 108 102 tmltrdm_trc !: total cumulative trends over the analysis window 109 103 110 # else104 # else 111 105 LOGICAL, PARAMETER :: lk_trdmld_trc = .FALSE. !: ML trend flag 112 # endif106 # endif 113 107 114 # if defined key_lobster108 # if defined key_lobster 115 109 CHARACTER(LEN=80) :: clname_bio, ctrd_bio(jpdiabio,2) 116 REAL(wp), DIMENSION(jpi,jpj,jpdiabio) :: &110 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: & 117 111 tmltrd_bio, & !: \ biological contributions to the total trend , 118 112 !: / cumulated over the current analysis window … … 122 116 !: upper triangle 123 117 #endif 118 !!---------------------------------------------------------------------- 119 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 120 !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmld_oce.F90,v 1.2 2005/03/27 18:35:23 opalod Exp $ 121 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 122 !!---------------------------------------------------------------------- 123 CONTAINS 124 125 INTEGER FUNCTION trd_mod_trc_oce_alloc() 126 !!---------------------------------------------------------------------- 127 !! *** ROUTINE trd_mod_trc_oce_alloc *** 128 !!---------------------------------------------------------------------- 129 USE lib_mpp, ONLY: ctl_warn 130 INTEGER :: ierr(2) 131 !!---------------------------------------------------------------------- 132 ierr(:) = 0 133 ! 134 # if defined key_trdmld_trc 135 ALLOCATE(nmld_trc(jpi,jpj), nbol_trc(jpi,jpj), & 136 wkx_trc(jpi,jpj,jpk), rmld_trc(jpi,jpj), & 137 rmld_sum_trc(jpi,jpj), rmldbn_trc(jpi,jpj), & 138 tml_trc(jpi,jpj,jptra), tmlb_trc(jpi,jpj,jptra), & 139 tmlbb_trc(jpi,jpj,jptra), tmlbn_trc(jpi,jpj,jptra), & 140 tml_sum_trc(jpi,jpj,jptra), tml_sumb_trc(jpi,jpj,jptra), & 141 tmltrd_atf_sumb_trc(jpi,jpj,jptra), & 142 tmltrd_rad_sumb_trc(jpi,jpj,jptra), & 143 ! 144 tmlatfb_trc(jpi,jpj,jptra), tmlatfn_trc(jpi,jpj,jptra), & 145 tmlatfm_trc(jpi,jpj,jptra), tmlradb_trc(jpi,jpj,jptra), & 146 tmlradn_trc(jpi,jpj,jptra), tmlradm_trc(jpi,jpj,jptra), & 147 ! 148 tmltrd_trc(jpi,jpj,jpltrd_trc,jptra) , & 149 tmltrd_sum_trc(jpi,jpj,jpltrd_trc,jptra) , & 150 tmltrd_csum_ln_trc(jpi,jpj,jpltrd_trc,jptra) , & 151 tmltrd_csum_ub_trc(jpi,jpj,jpltrd_trc,jptra) , & 152 ! 153 tmltrdm_trc(jpi,jpj,jptra) , STAT=ierr(1) ) 154 #endif 155 ! 156 # if defined key_lobster 157 ALLOCATE( tmltrd_bio (jpi,jpj,jpdiabio) , & 158 & tmltrd_sum_bio (jpi,jpj,jpdiabio) , & 159 & tmltrd_csum_ln_bio(jpi,jpj,jpdiabio) , & 160 & tmltrd_csum_ub_bio(jpi,jpj,jpdiabio) , STAT=ierr(2) ) 161 # endif 162 ! 163 trd_mod_trc_oce_alloc = MAXVAL(ierr) 164 ! 165 IF( trd_mod_trc_oce_alloc /= 0 ) CALL ctl_warn('trd_mod_trc_oce_alloc: failed to allocate arrays') 166 ! 167 # if defined key_trdmld_trc 168 jpktrd_trc = jpk ! Initialise what used to be a parameter - max level for mixed-layer trends diag. 169 # endif 170 ! 171 END FUNCTION trd_mod_trc_oce_alloc 124 172 125 173 #else … … 129 177 #endif 130 178 131 179 !!====================================================================== 132 180 END MODULE trdmod_trc_oce -
trunk/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r2528 r2715 33 33 !* IO manager * 34 34 USE in_out_manager 35 35 36 !* MPP library 37 USE lib_mpp 38 39 !* Fortran utilities 40 USE lib_fortran 41 42 !* Lateral boundary conditions 43 USE lbclnk 44 36 45 !* physical constants * 37 46 USE phycst … … 88 97 USE dom_oce , ONLY : e1t => e1t !: horizontal scale factors at t-point (m) 89 98 USE dom_oce , ONLY : e2t => e2t !: horizontal scale factors at t-point (m) 99 USE dom_oce , ONLY : e1e2t => e1e2t !: cell surface at t-point (m2) 90 100 USE dom_oce , ONLY : e1u => e1u !: horizontal scale factors at u-point (m) 91 101 USE dom_oce , ONLY : e2u => e2u !: horizontal scale factors at u-point (m) … … 194 204 195 205 #endif 196 USE lib_mpp , ONLY : lk_mpp => lk_mpp !: Mpp flag197 206 198 207 USE dom_oce , ONLY : nn_cla => nn_cla !: flag (0/1) for cross land advection -
trunk/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90
r2528 r2715 17 17 USE par_trc ! TOP parameters 18 18 USE oce_trc ! ocean space and time domain variables 19 USE in_out_manager ! I/O manager20 USE lib_mpp ! distributed memory computing21 19 22 20 IMPLICIT NONE … … 69 67 INTEGER , INTENT(in), OPTIONAL :: kdim ! k- direction for 4D arrays 70 68 !! 69 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zmask, ztab3d 71 70 INTEGER :: overlap, jn, js, sind, eind, kdir, j_id 72 71 REAL(wp) :: zsum, zvctl 73 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask, ztab3d74 72 CHARACTER (len=20), DIMENSION(jptra) :: cl 75 73 CHARACTER (len=10) :: cl2 76 74 !!---------------------------------------------------------------------- 77 75 76 ALLOCATE( zmask (jpi,jpj,jpk) ) 77 ALLOCATE( ztab3d(jpi,jpj,jpk) ) 78 78 ! ! Arrays, scalars initialization 79 79 overlap = 0 … … 150 150 ! 151 151 END DO 152 ! 153 DEALLOCATE( zmask ) 154 DEALLOCATE( ztab3d ) 152 155 ! 153 156 END SUBROUTINE prt_ctl_trc -
trunk/NEMOGCM/NEMO/TOP_SRC/trc.F90
r2568 r2715 19 19 PUBLIC 20 20 21 PUBLIC trc_alloc ! called by nemogcm.F90 22 21 23 !! passive tracers names and units (read in namelist) 22 24 !! -------------------------------------------------- … … 34 36 !! passive tracers fields (before,now,after) 35 37 !! -------------------------------------------------- 36 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: cvol !: volume correction -degrad option-37 38 REAL(wp), PUBLIC :: trai !: initial total tracer 38 39 REAL(wp), PUBLIC :: areatot !: total volume 39 40 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) :: trn !: traceur concentration for actualtime step41 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) :: tra!: traceur concentration for next time step42 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) :: trb!: traceur concentration for before time step40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: cvol !: volume correction -degrad option- 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) :: trn !: traceur concentration for now time step 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) :: tra !: traceur concentration for next time step 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) :: trb !: traceur concentration for before time step 43 44 44 45 !! interpolated gradient 45 46 !!-------------------------------------------------- 46 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) :: gtru !: horizontalgradient at u-points at bottom ocean level47 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) :: gtrv !: horizontalgradient at v-points at bottom ocean level47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: gtru !: hor. gradient at u-points at bottom ocean level 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: gtrv !: hor. gradient at v-points at bottom ocean level 48 49 49 50 !! passive tracers restart (input and output) 50 51 !! ------------------------------------------ 51 LOGICAL , PUBLIC :: ln_rsttr!: boolean term for restart i/o for passive tracers (namelist)52 LOGICAL , PUBLIC :: lrst_trc!: logical to control the trc restart write53 INTEGER , PUBLIC :: nn_dttrc!: frequency of step on passive tracers54 INTEGER , PUBLIC :: nutwrs!: output FILE for passive tracers restart55 INTEGER , PUBLIC :: nutrst!: logical unit for restart FILE for passive tracers56 INTEGER , PUBLIC :: nn_rsttr!: control of the time step ( 0 or 1 ) for pass. tr.57 CHARACTER(len=50), PUBLIC :: cn_trcrst_in !: suffix of pass. tracer restart name (input)58 CHARACTER(len=50), PUBLIC :: cn_trcrst_out !: suffix of pass. tracer restart name (output)52 LOGICAL , PUBLIC :: ln_rsttr !: boolean term for restart i/o for passive tracers (namelist) 53 LOGICAL , PUBLIC :: lrst_trc !: logical to control the trc restart write 54 INTEGER , PUBLIC :: nn_dttrc !: frequency of step on passive tracers 55 INTEGER , PUBLIC :: nutwrs !: output FILE for passive tracers restart 56 INTEGER , PUBLIC :: nutrst !: logical unit for restart FILE for passive tracers 57 INTEGER , PUBLIC :: nn_rsttr !: control of the time step ( 0 or 1 ) for pass. tr. 58 CHARACTER(len=50), PUBLIC :: cn_trcrst_in !: suffix of pass. tracer restart name (input) 59 CHARACTER(len=50), PUBLIC :: cn_trcrst_out !: suffix of pass. tracer restart name (output) 59 60 60 61 !! information for outputs 61 62 !! -------------------------------------------------- 62 63 INTEGER , PUBLIC :: nn_writetrc !: time step frequency for concentration outputs (namelist) 63 REAL(wp), PUBLIC, DIMENSION(jpk) :: rdttrc !: vertical profile of passive tracer time step64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdttrc !: vertical profile of passive tracer time step 64 65 65 66 # if defined key_diatrc && ! defined key_iomput 66 67 !! additional 2D/3D outputs namelist 67 68 !! -------------------------------------------------- 68 INTEGER , PUBLIC:: nn_writedia !: frequency of additional arrays outputs(namelist)69 CHARACTER(len= 8), PUBLIC, DIMENSION 70 CHARACTER(len= 8), PUBLIC, DIMENSION 71 CHARACTER(len= 8), PUBLIC, DIMENSION 72 CHARACTER(len= 8), PUBLIC, DIMENSION 73 CHARACTER(len=80), PUBLIC, DIMENSION 74 CHARACTER(len=80), PUBLIC, DIMENSION 69 INTEGER , PUBLIC :: nn_writedia !: frequency of additional arrays outputs(namelist) 70 CHARACTER(len= 8), PUBLIC, DIMENSION(jpdia2d) :: ctrc2d !: 2d output field name 71 CHARACTER(len= 8), PUBLIC, DIMENSION(jpdia2d) :: ctrc2u !: 2d output field unit 72 CHARACTER(len= 8), PUBLIC, DIMENSION(jpdia3d) :: ctrc3d !: 3d output field name 73 CHARACTER(len= 8), PUBLIC, DIMENSION(jpdia3d) :: ctrc3u !: 3d output field unit 74 CHARACTER(len=80), PUBLIC, DIMENSION(jpdia2d) :: ctrc2l !: 2d output field long name 75 CHARACTER(len=80), PUBLIC, DIMENSION(jpdia3d) :: ctrc3l !: 3d output field long name 75 76 76 REAL(wp), PUBLIC, DIMENSION (jpi,jpj, jpdia2d) :: trc2d !: additional 2d outputs 77 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jpdia3d) :: trc3d !: additional 3d outputs 78 77 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:, :) :: trc2d !: additional 2d outputs 78 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trc3d !: additional 3d outputs 79 79 # endif 80 80 81 # if defined key_diabio || defined key_trdmld_trc81 # if defined key_diabio || defined key_trdmld_trc 82 82 ! !!* namtop_XXX namelist * 83 83 INTEGER , PUBLIC :: nn_writebio !: time step frequency for biological outputs … … 85 85 CHARACTER(len=20), PUBLIC, DIMENSION(jpdiabio) :: ctrbiu !: biological trends unit 86 86 CHARACTER(len=80), PUBLIC, DIMENSION(jpdiabio) :: ctrbil !: biological trends long name 87 # endif87 # endif 88 88 # if defined key_diabio 89 89 !! Biological trends 90 90 !! ----------------- 91 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jpdiabio) ::trbio !: biological trends91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trbio !: biological trends 92 92 # endif 93 93 … … 99 99 # endif 100 100 101 !!---------------------------------------------------------------------- 102 !! NEMO/TOP 3.3.1 , NEMO Consortium (2010) 103 !! $Id$ 104 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 105 !!---------------------------------------------------------------------- 106 CONTAINS 107 108 INTEGER FUNCTION trc_alloc() 109 !!------------------------------------------------------------------- 110 !! *** ROUTINE trc_alloc *** 111 !!------------------------------------------------------------------- 112 USE lib_mpp, ONLY: ctl_warn 113 !!------------------------------------------------------------------- 114 ! 115 ALLOCATE( cvol(jpi,jpj,jpk ) , & 116 & trn (jpi,jpj,jpk,jptra) , & 117 & tra (jpi,jpj,jpk,jptra) , & 118 & trb (jpi,jpj,jpk,jptra) , & 119 & gtru(jpi,jpj ,jptra) , gtrv(jpi,jpj,jptra) , & 120 # if defined key_diatrc && ! defined key_iomput 121 & trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d), & 122 # endif 123 # if defined key_diabio 124 & trbio(jpi,jpj,jpk,jpdiabio), & 125 #endif 126 rdttrc(jpk) , STAT=trc_alloc ) 127 128 IF( trc_alloc /= 0 ) CALL ctl_warn('trc_alloc: failed to allocate arrays') 129 ! 130 END FUNCTION trc_alloc 131 101 132 #else 102 133 !!---------------------------------------------------------------------- … … 105 136 #endif 106 137 107 !!----------------------------------------------------------------------108 !! NEMO/TOP 3.3 , NEMO Consortium (2010)109 !! $Id$110 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)111 138 !!====================================================================== 112 139 END MODULE trc -
trunk/NEMOGCM/NEMO/TOP_SRC/trcdia.F90
r2567 r2715 25 25 USE par_trc 26 26 USE dianam ! build name of file (routine) 27 USE in_out_manager ! I/O manager28 USE lib_mpp29 27 USE ioipsl 30 28 … … 32 30 PRIVATE 33 31 34 PUBLIC trc_dia ! called by XXX module 32 PUBLIC trc_dia ! called by XXX module 33 PUBLIC trc_dia_alloc ! called by nemogcm.F90 35 34 36 35 INTEGER :: nit5 !: id for tracer output file … … 40 39 INTEGER :: ndimt51 !: number of ocean points in index array 41 40 REAL(wp) :: zjulian !: ???? not DOCTOR ! 42 INTEGER , DIMENSION (jpij*jpk) :: ndext50 !: integer arrays for ocean 3D index43 INTEGER , DIMENSION (jpij):: ndext51 !: integer arrays for ocean surface index41 INTEGER , ALLOCATABLE, SAVE, DIMENSION (:) :: ndext50 !: integer arrays for ocean 3D index 42 INTEGER , ALLOCATABLE, SAVE, DIMENSION (:) :: ndext51 !: integer arrays for ocean surface index 44 43 # if defined key_diatrc 45 44 INTEGER :: nitd !: id for additional array output file … … 58 57 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 59 58 !! $Id$ 60 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)59 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 61 60 !!---------------------------------------------------------------------- 62 61 CONTAINS … … 68 67 !! ** Purpose : output passive tracers fields 69 68 !!--------------------------------------------------------------------- 70 INTEGER, INTENT( in ) :: kt 71 INTEGER :: kindic 69 INTEGER, INTENT(in) :: kt ! ocean time-step 70 ! 71 INTEGER :: kindic ! local integer 72 72 !!--------------------------------------------------------------------- 73 73 ! … … 95 95 !! IF kindic >0, output of fields before the time step loop 96 96 !!---------------------------------------------------------------------- 97 INTEGER, INTENT( in ) :: kt! ocean time-step98 INTEGER, INTENT( in ) :: kindic! indicator of abnormal termination99 ! !97 INTEGER, INTENT(in) :: kt ! ocean time-step 98 INTEGER, INTENT(in) :: kindic ! indicator of abnormal termination 99 ! 100 100 INTEGER :: jn 101 101 LOGICAL :: ll_print = .FALSE. … … 183 183 DO jn = 1, jptra 184 184 IF( lutsav(jn) ) THEN 185 cltra = ctrcnm(jn) ! short title for tracer186 cltral = ctrcnl(jn) ! long title for tracer187 cltrau = ctrcun(jn) ! UNIT for tracer185 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 186 cltral = TRIM( ctrcnl(jn) ) ! long title for tracer 187 cltrau = TRIM( ctrcun(jn) ) ! UNIT for tracer 188 188 CALL histdef( nit5, cltra, cltral, cltrau, jpi, jpj, nhorit5, & 189 189 & ipk, 1, ipk, ndepit5, 32, clop, zsto, zout ) … … 208 208 209 209 DO jn = 1, jptra 210 cltra = ctrcnm(jn)! short title for tracer210 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 211 211 IF( lutsav(jn) ) CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 ) 212 212 END DO … … 216 216 IF( kt == nitend .OR. kindic < 0 ) CALL histclo( nit5 ) 217 217 ! 218 219 218 END SUBROUTINE trcdit_wr 220 219 … … 237 236 !! IF kindic >0, output of fields before the time step loop 238 237 !!---------------------------------------------------------------------- 239 INTEGER, INTENT( in ) :: kt! ocean time-step240 INTEGER, INTENT( in ) :: kindic! indicator of abnormal termination238 INTEGER, INTENT(in) :: kt ! ocean time-step 239 INTEGER, INTENT(in) :: kindic ! indicator of abnormal termination 241 240 !! 242 241 LOGICAL :: ll_print = .FALSE. … … 308 307 ! more 3D horizontal arrays 309 308 DO jl = 1, jpdia3d 310 cltra = ctrc3d(jl) ! short title for 3D diagnostic311 cltral = ctrc3l(jl)! long title for 3D diagnostic312 cltrau = ctrc3u(jl)! UNIT for 3D diagnostic309 cltra = TRIM( ctrc3d(jl) ) ! short title for 3D diagnostic 310 cltral = TRIM( ctrc3l(jl) ) ! long title for 3D diagnostic 311 cltrau = TRIM( ctrc3u(jl) ) ! UNIT for 3D diagnostic 313 312 CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd, & 314 313 & ipk, 1, ipk, ndepitd, 32, clop, zsto, zout ) … … 317 316 ! more 2D horizontal arrays 318 317 DO jl = 1, jpdia2d 319 cltra = ctrc2d(jl)! short title for 2D diagnostic320 cltral = ctrc2l(jl)! long title for 2D diagnostic321 cltrau = ctrc2u(jl)! UNIT for 2D diagnostic318 cltra = TRIM( ctrc2d(jl) ) ! short title for 2D diagnostic 319 cltral = TRIM( ctrc2l(jl) ) ! long title for 2D diagnostic 320 cltrau = TRIM( ctrc2u(jl) ) ! UNIT for 2D diagnostic 322 321 CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd, & 323 322 & 1, 1, 1, -99, 32, clop, zsto, zout ) … … 345 344 ! more 3D horizontal arrays 346 345 DO jl = 1, jpdia3d 347 cltra = ctrc3d(jl) ! short title for 3D diagnostic346 cltra = TRIM( ctrc3d(jl) ) ! short title for 3D diagnostic 348 347 CALL histwrite( nitd, cltra, it, trc3d(:,:,:,jl), ndimt50 ,ndext50) 349 348 END DO … … 351 350 ! more 2D horizontal arrays 352 351 DO jl = 1, jpdia2d 353 cltra = ctrc2d(jl) ! short title for 2D diagnostic352 cltra = TRIM( ctrc2d(jl) ) ! short title for 2D diagnostic 354 353 CALL histwrite(nitd, cltra, it, trc2d(:,:,jl), ndimt51 ,ndext51) 355 354 END DO … … 364 363 # else 365 364 SUBROUTINE trcdii_wr( kt, kindic ) ! Dummy routine 366 INTEGER, INTENT ( in) :: kt, kindic365 INTEGER, INTENT (in) :: kt, kindic 367 366 END SUBROUTINE trcdii_wr 368 367 # endif … … 400 399 ! Initialisation 401 400 ! -------------- 402 403 401 404 402 ! local variable for debugging … … 451 449 ! biological trends 452 450 DO jl = 1, jpdiabio 453 cltra = ctrbio(jl) ! short title for biological diagnostic454 cltral = ctrbil(jl)! long title for biological diagnostic455 cltrau = ctrbiu(jl)! UNIT for biological diagnostic451 cltra = TRIM( ctrbio(jl) ) ! short title for biological diagnostic 452 cltral = TRIM( ctrbil(jl) ) ! long title for biological diagnostic 453 cltrau = TRIM( ctrbiu(jl) ) ! UNIT for biological diagnostic 456 454 CALL histdef( nitb, cltra, cltral, cltrau, jpi, jpj, nhoritb, & 457 455 & ipk, 1, ipk, ndepitb, 32, clop, zsto, zout) … … 477 475 478 476 DO jl = 1, jpdiabio 479 cltra = ctrbio(jl)! short title for biological diagnostic477 cltra = TRIM( ctrbio(jl) ) ! short title for biological diagnostic 480 478 CALL histwrite(nitb, cltra, it, trbio(:,:,:,jl), ndimt50,ndext50) 481 479 END DO … … 485 483 IF( kt == nitend .OR. kindic < 0 ) CALL histclo( nitb ) 486 484 ! 487 488 485 END SUBROUTINE trcdib_wr 489 486 … … 496 493 # endif 497 494 495 INTEGER FUNCTION trc_dia_alloc() 496 !!--------------------------------------------------------------------- 497 !! *** ROUTINE trc_dia_alloc *** 498 !!--------------------------------------------------------------------- 499 ALLOCATE( ndext50(jpij*jpk), ndext51(jpij), STAT=trc_dia_alloc ) 500 ! 501 IF( trc_dia_alloc /= 0 ) CALL ctl_warn('trc_dia_alloc : failed to allocate arrays') 502 ! 503 END FUNCTION trc_dia_alloc 498 504 #else 499 505 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r2528 r2715 23 23 PRIVATE 24 24 25 PUBLIC trc_dta ! called in trcini.F90 and trcdmp.F90 25 PUBLIC trc_dta ! called in trcini.F90 and trcdmp.F90 26 PUBLIC trc_dta_alloc ! called in nemogcm.F90 26 27 27 28 LOGICAL , PUBLIC, PARAMETER :: lk_dtatrc = .TRUE. !: temperature data flag 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jptra) :: trdta !: tracer data at given time-step29 30 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,2) :: tracdta! tracer data at two consecutive times31 INTEGER , DIMENSION(jptra) :: nlectr !: switch for reading once32 INTEGER , DIMENSION(jptra) :: ntrc1 !: number of first month when reading 12 monthly value33 INTEGER , DIMENSION(jptra) :: ntrc2 !: number of second month when reading 12 monthly value29 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trdta !: tracer data at given time-step 30 31 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) :: tracdta ! tracer data at two consecutive times 32 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) :: nlectr !: switch for reading once 33 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) :: ntrc1 !: number of 1st month when reading 12 monthly value 34 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) :: ntrc2 !: number of 2nd month when reading 12 monthly value 34 35 35 36 !! * Substitutions … … 38 39 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 39 40 !! $Id$ 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 41 42 !!---------------------------------------------------------------------- 42 43 CONTAINS … … 55 56 !! two monthly values. 56 57 !!---------------------------------------------------------------------- 57 INTEGER, INTENT( in) :: kt ! ocean time-step58 INTEGER, INTENT(in) :: kt ! ocean time-step 58 59 !! 59 60 CHARACTER (len=39) :: clname(jptra) … … 198 199 END SUBROUTINE trc_dta 199 200 201 202 INTEGER FUNCTION trc_dta_alloc() 203 !!---------------------------------------------------------------------- 204 !! *** ROUTINE trc_dta_alloc *** 205 !!---------------------------------------------------------------------- 206 ALLOCATE( trdta (jpi,jpj,jpk,jptra ) , & 207 & tracdta(jpi,jpj,jpk,jptra,2) , & 208 & nlectr(jptra) , ntrc1(jptra) , ntrc2(jptra) , STAT=trc_dta_alloc) 209 ! 210 IF( trc_dta_alloc /= 0 ) CALL ctl_warn('trc_dta_alloc : failed to allocate arrays') 211 ! 212 END FUNCTION trc_dta_alloc 213 200 214 #else 201 215 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r2555 r2715 4 4 !! TOP : Manage the passive tracer initialization 5 5 !!====================================================================== 6 !! History : - ! 1991-03 () original code7 !! 1.0 !2005-03 (O. Aumont, A. El Moussaoui) F908 !! - ! 2005-10 (C. Ethe) print control9 !! 2.0 ! 2005-10 (C. Ethe, G. Madec) revised architecture6 !! History : - ! 1991-03 (O. Marti) original code 7 !! 1.0 ! 2005-03 (O. Aumont, A. El Moussaoui) F90 8 !! 2.0 ! 2005-10 (C. Ethe, G. Madec) revised architecture 9 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 10 10 !!---------------------------------------------------------------------- 11 11 #if defined key_top … … 13 13 !! 'key_top' TOP models 14 14 !!---------------------------------------------------------------------- 15 !! ----------------------------------------------------------------------16 !! t rc_init : Initialization for passive tracer15 !! trc_init : Initialization for passive tracer 16 !! top_alloc : allocate the TOP arrays 17 17 !!---------------------------------------------------------------------- 18 18 USE oce_trc … … 26 26 USE trcini_my_trc ! MY_TRC initialisation 27 27 USE trcdta 28 #if defined key_offline29 28 USE daymod 30 #endif31 29 USE zpshde ! partial step: hor. derivative (zps_hde routine) 32 USE in_out_manager ! I/O manager33 30 USE prtctl_trc ! Print control passive tracers (prt_ctl_trc_init routine) 34 USE lib_mpp ! distributed memory computing library35 USE lib_fortran !36 31 37 32 IMPLICIT NONE … … 42 37 !! * Substitutions 43 38 # include "domzgr_substitute.h90" 44 39 !!---------------------------------------------------------------------- 40 !! NEMO/TOP 4.0 , NEMO Consortium (2011) 41 !! $Id$ 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 43 !!---------------------------------------------------------------------- 45 44 CONTAINS 46 45 … … 59 58 INTEGER :: jk, jn ! dummy loop indices 60 59 CHARACTER (len=25) :: charout 61 62 60 !!--------------------------------------------------------------------- 63 61 … … 66 64 IF(lwp) WRITE(numout,*) '~~~~~~~' 67 65 68 ! ! masked grid volume 66 CALL top_alloc() ! allocate TOP arrays 67 68 ! ! masked grid volume 69 69 DO jk = 1, jpk 70 70 cvol(:,:,jk) = e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) 71 71 END DO 72 72 73 ! total volume of the ocean73 ! ! total volume of the ocean 74 74 #if ! defined key_degrad 75 75 areatot = glob_sum( cvol(:,:,:) ) … … 78 78 #endif 79 79 80 CALL trc_nam! read passive tracers namelists81 82 ! restart for passive tracer (input)80 CALL trc_nam ! read passive tracers namelists 81 82 ! ! restart for passive tracer (input) 83 83 IF( ln_rsttr ) THEN 84 84 IF(lwp) WRITE(numout,*) ' read a restart file for passive tracer : ', cn_trcrst_in 85 85 IF(lwp) WRITE(numout,*) ' ' 86 86 ELSE 87 IF(lwp) WRITE(numout,*) 88 DO jn = 1, jptra 89 IF( lwp .AND. lutini(jn) ) & ! open input FILE only IF lutini(jn) is true 90 & WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' traceur : ', ctrcnm(jn) 91 END DO 87 IF( lwp .AND. lk_dtatrc ) THEN 88 DO jn = 1, jptra 89 IF( lutini(jn) ) & ! open input FILE only IF lutini(jn) is true 90 & WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' traceur : ', ctrcnm(jn) 91 END DO 92 ENDIF 93 IF( lwp ) WRITE(numout,*) 92 94 ENDIF 93 95 … … 138 140 ENDIF 139 141 140 tra(:,:,:,:) = 0. 142 tra(:,:,:,:) = 0._wp 141 143 142 144 IF( ln_zps .AND. .NOT. lk_c1d ) & ! Partial steps: before horizontal gradient of passive 143 &CALL zps_hde( nit000, jptra, trn, gtru, gtrv ) ! tracers at the bottom ocean level144 145 146 ! ! Computation content of all tracers147 trai = 0. e0145 & CALL zps_hde( nit000, jptra, trn, gtru, gtrv ) ! tracers at the bottom ocean level 146 147 148 ! 149 trai = 0._wp ! Computation content of all tracers 148 150 DO jn = 1, jptra 149 151 #if ! defined key_degrad … … 154 156 END DO 155 157 156 ! ! control print 157 IF(lwp) WRITE(numout,*) 158 IF(lwp) WRITE(numout,*) 159 IF(lwp) WRITE(numout,*) ' *** Total number of passive tracer jptra = ', jptra 160 IF(lwp) WRITE(numout,*) ' *** Total volume of ocean = ', areatot 161 IF(lwp) WRITE(numout,*) ' *** Total inital content of all tracers = ', trai 162 IF(lwp) WRITE(numout,*) 163 164 IF( ln_ctl ) CALL prt_ctl_trc_init ! control print 165 ! 166 167 IF(ln_ctl) THEN ! print mean trends (used for debugging) 158 IF(lwp) THEN ! control print 159 WRITE(numout,*) 160 WRITE(numout,*) 161 WRITE(numout,*) ' *** Total number of passive tracer jptra = ', jptra 162 WRITE(numout,*) ' *** Total volume of ocean = ', areatot 163 WRITE(numout,*) ' *** Total inital content of all tracers = ', trai 164 WRITE(numout,*) 165 ENDIF 166 167 IF(ln_ctl) THEN ! print mean trends (used for debugging) 168 CALL prt_ctl_trc_init 168 169 WRITE(charout, FMT="('ini ')") 169 170 CALL prt_ctl_trc_info( charout ) 170 171 CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 171 172 ENDIF 172 173 ! 173 174 END SUBROUTINE trc_init 175 176 177 SUBROUTINE top_alloc 178 !!---------------------------------------------------------------------- 179 !! *** ROUTINE top_alloc *** 180 !! 181 !! ** Purpose : Allocate all the dynamic arrays of the OPA modules 182 !!---------------------------------------------------------------------- 183 USE trcadv , ONLY: trc_adv_alloc ! TOP-related alloc routines... 184 USE trc , ONLY: trc_alloc 185 USE trcnxt , ONLY: trc_nxt_alloc 186 USE trczdf , ONLY: trc_zdf_alloc 187 USE trdmod_trc_oce, ONLY: trd_mod_trc_oce_alloc 188 #if ! defined key_iomput 189 USE trcdia , ONLY: trc_dia_alloc 190 #endif 191 #if defined key_trcdmp 192 USE trcdmp , ONLY: trc_dmp_alloc 193 #endif 194 #if defined key_dtatrc 195 USE trcdta , ONLY: trc_dta_alloc 196 #endif 197 #if defined key_trdmld_trc || defined key_esopa 198 USE trdmld_trc , ONLY: trd_mld_trc_alloc 199 #endif 200 ! 201 INTEGER :: ierr 202 !!---------------------------------------------------------------------- 203 ! 204 ierr = trc_adv_alloc() ! Start of TOP-related alloc routines... 205 ierr = ierr + trc_alloc () 206 ierr = ierr + trc_nxt_alloc() 207 ierr = ierr + trc_zdf_alloc() 208 ierr = ierr + trd_mod_trc_oce_alloc() 209 #if ! defined key_iomput 210 ierr = ierr + trc_dia_alloc() 211 #endif 212 #if defined key_trcdmp 213 ierr = ierr + trc_dmp_alloc() 214 #endif 215 #if defined key_dtatrc 216 ierr = ierr + trc_dta_alloc() 217 #endif 218 #if defined key_trdmld_trc || defined key_esopa 219 ierr = ierr + trd_mld_trc_alloc() 220 #endif 221 ! 222 IF( lk_mpp ) CALL mpp_sum( ierr ) 223 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'top_alloc : unable to allocate standard ocean arrays' ) 224 ! 225 END SUBROUTINE top_alloc 174 226 175 227 #else … … 182 234 #endif 183 235 184 !!----------------------------------------------------------------------185 !! NEMO/TOP 3.3 , NEMO Consortium (2010)186 !! $Id$187 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)188 236 !!====================================================================== 189 237 END MODULE trcini -
trunk/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r2528 r2715 26 26 USE trcnam_c14b ! C14 SMS namelist 27 27 USE trcnam_my_trc ! MY_TRC SMS namelist 28 USE in_out_manager ! I/O manager29 28 USE trdmod_trc_oce 30 29 … … 103 102 104 103 DO jn = 1, jptra 105 ctrcnm(jn) = sn_tracer(jn)%clsname106 ctrcnl(jn) = sn_tracer(jn)%cllname107 ctrcun(jn) = sn_tracer(jn)%clunit108 lutini(jn) = sn_tracer(jn)%llinit109 lutsav(jn) = sn_tracer(jn)%llsave104 ctrcnm(jn) = TRIM( sn_tracer(jn)%clsname ) 105 ctrcnl(jn) = TRIM( sn_tracer(jn)%cllname ) 106 ctrcun(jn) = TRIM( sn_tracer(jn)%clunit ) 107 lutini(jn) = sn_tracer(jn)%llinit 108 lutsav(jn) = sn_tracer(jn)%llsave 110 109 END DO 111 110 … … 121 120 DO jn = 1, jptra 122 121 WRITE(numout,*) ' tracer nb : ', jn 123 WRITE(numout,*) ' short name : ', TRIM(ctrcnm(jn))124 WRITE(numout,*) ' long name : ', TRIM(ctrcnl(jn))125 WRITE(numout,*) ' unit : ', TRIM(ctrcun(jn))122 WRITE(numout,*) ' short name : ', ctrcnm(jn) 123 WRITE(numout,*) ' long name : ', ctrcnl(jn) 124 WRITE(numout,*) ' unit : ', ctrcun(jn) 126 125 WRITE(numout,*) ' initial value in FILE : ', lutini(jn) 127 126 WRITE(numout,*) ' ' -
trunk/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r2528 r2715 26 26 USE trc 27 27 USE trcnam_trp 28 USE lib_mpp29 USE lib_fortran30 28 USE iom 31 29 USE trcrst_cfc ! CFC -
trunk/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
r2528 r2715 30 30 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 31 31 !! $Id$ 32 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)32 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 33 33 !!---------------------------------------------------------------------- 34 35 34 CONTAINS 36 35
Note: See TracChangeset
for help on using the changeset viewer.