Changeset 2643 for branches/dev_r2586_dynamic_mem/NEMOGCM
- Timestamp:
- 2011-03-02T19:38:35+01:00 (13 years ago)
- Location:
- branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC
- Files:
-
- 51 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/C14b/trcini_c14b.F90
r2528 r2643 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 … … 59 58 !!---------------------------------------------------------------------- 60 59 61 ! Control consitency 62 CALL trc_ctl_c14b 60 CALL c14b_alloc() ! Allocate CFC arrays 61 62 CALL trc_ctl_c14b ! Control consitency 63 63 64 64 IF(lwp) WRITE(numout,*) '' … … 164 164 165 165 END SUBROUTINE trc_ini_c14b 166 167 SUBROUTINE c14b_alloc 168 !!---------------------------------------------------------------------- 169 !! *** ROUTINE c14b_alloc *** 170 !! 171 !! ** Purpose : Allocate all the dynamic arrays of C14b 172 !!---------------------------------------------------------------------- 173 174 ! ! Allocate C14b arrays 175 IF( trc_sms_c14b_alloc() /= 0 ) & 176 & CALL ctl_stop( 'STOP', 'trc_ini_c14b : unable to allocate C14b arrays' ) 177 ! 178 END SUBROUTINE c14b_alloc 166 179 167 180 SUBROUTINE trc_ctl_c14b -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/C14b/trcnam_c14b.F90
r2567 r2643 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 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/C14b/trcrst_c14b.F90
r2528 r2643 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 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
r2633 r2643 63 63 CONTAINS 64 64 65 FUNCTION trc_sms_c14b_alloc()66 !!----------------------------------------------------------------------67 !! *** ROUTINE trc_sms_c14b_alloc ***68 !!----------------------------------------------------------------------69 INTEGER :: trc_sms_c14b_alloc ! Return value70 !!----------------------------------------------------------------------71 72 ALLOCATE(fareaz(jpi,jpj ,jpzon), &73 qtr_c14(jpi,jpj) , &74 qint_c14(jpi,jpj) , Stat=trc_sms_c14b_alloc)75 76 IF (trc_sms_c14b_alloc /= 0) CALL ctl_warn('trc_sms_c14b_alloc : failed to allocate arrays.')77 78 END FUNCTION trc_sms_c14b_alloc79 80 65 81 66 SUBROUTINE trc_sms_c14b( kt ) … … 121 106 122 107 !! * Local declarations 123 INTEGER :: & 124 ji, jj, jk, jz 125 126 INTEGER :: & 127 iyear_beg, & 128 iyear_beg1, iyear_end1, & 129 imonth1, im1, im2, & 130 iyear_beg2, iyear_end2, & 131 imonth2, in1, in2 108 INTEGER :: ji, jj, jk, jz ! dummy loop indices 109 110 INTEGER :: iyear_beg, iyear_beg1, iyear_end1 111 INTEGER :: iyear_beg2, iyear_end2 112 INTEGER :: imonth1, im1, in1 113 INTEGER :: imonth2, im2, in2 132 114 133 REAL(wp), DIMENSION(jpzon) :: & 134 zonbc14 !: time interp atm C14 135 136 REAL(wp) :: & 137 zpco2at !: time interp atm C02 138 139 REAL(wp) :: & !: dummy variables 140 zt, ztp, zsk, & 141 zsol , & !: solubility 142 zsch , & !: schmidt number 143 zv2 , & !: wind speed ( square) 144 zpv , & !: piston velocity 145 zdemi, ztra 115 REAL(wp), DIMENSION(jpzon) :: zonbc14 !: time interp atm C14 116 REAL(wp) :: zpco2at !: time interp atm C02 117 118 REAL(wp) :: zt, ztp, zsk !: dummy variables 119 REAL(wp) :: zsol !: solubility 120 REAL(wp) :: zsch !: schmidt number 121 REAL(wp) :: zv2 !: wind speed ( square) 122 REAL(wp) :: zpv !: piston velocity 123 REAL(wp) :: zdemi, ztra 146 124 !!---------------------------------------------------------------------- 147 125 148 IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1) )THEN126 IF( ( wrk_in_use(2, 1) ) .OR. ( wrk_in_use(3, 1) ) ) THEN 149 127 CALL ctl_stop('trc_sms_c14b : requested workspace arrays unavailable.') 150 128 RETURN … … 331 309 END IF 332 310 333 IF( wrk_not_released(2, 1) .OR. wrk_not_released(3, 1) )THEN 334 CALL ctl_stop('trc_sms_c14b : failed to release workspace arrays.') 335 END IF 311 IF( ( wrk_not_released(2, 1)) .OR. ( wrk_not_released(3, 1) ) ) & 312 & CALL ctl_stop('trc_sms_c14b : failed to release workspace arrays.') 336 313 337 314 END SUBROUTINE trc_sms_c14b 338 315 316 INTEGER FUNCTION trc_sms_c14b_alloc() 317 !!---------------------------------------------------------------------- 318 !! *** ROUTINE trc_sms_c14b_alloc *** 319 !!---------------------------------------------------------------------- 320 321 ALLOCATE( fareaz(jpi,jpj ,jpzon), & 322 & qtr_c14(jpi,jpj) , & 323 & qint_c14(jpi,jpj) , STAT=trc_sms_c14b_alloc ) 324 325 IF( trc_sms_c14b_alloc /= 0 ) CALL ctl_warn('trc_sms_c14b_alloc : failed to allocate arrays.') 326 327 END FUNCTION trc_sms_c14b_alloc 339 328 #else 340 329 !!---------------------------------------------------------------------- -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90
r2528 r2643 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 … … 45 44 !! ** Method : - Read the namcfc namelist and check the parameter values 46 45 !!---------------------------------------------------------------------- 47 INTEGER :: 48 REAL(wp) :: 46 INTEGER :: ji, jj, jn, jl, jm, js 47 REAL(wp) :: zyy , zyd 49 48 !!---------------------------------------------------------------------- 50 49 … … 52 51 IF(lwp) WRITE(numout,*) ' trc_ini_cfc: initialisation of CFC chemical model' 53 52 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 53 54 CALL cfc_alloc() ! Allocate CFC arrays 54 55 55 56 … … 140 141 141 142 END SUBROUTINE trc_ini_cfc 143 144 SUBROUTINE cfc_alloc 145 !!---------------------------------------------------------------------- 146 !! *** ROUTINE cfc_alloc *** 147 !! 148 !! ** Purpose : Allocate all the dynamic arrays of CFC 149 !!---------------------------------------------------------------------- 150 151 ! ! Allocate CFC arrays 152 IF( trc_sms_cfc_alloc() /= 0 ) & 153 & CALL ctl_stop( 'STOP', 'trc_ini_cfc : unable to allocate CFC arrays' ) 154 ! 155 END SUBROUTINE cfc_alloc 142 156 143 157 #else -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90
r2567 r2643 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 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/CFC/trcrst_cfc.F90
r2528 r2643 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 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r2633 r2643 60 60 CONTAINS 61 61 62 FUNCTION trc_sms_cfc_alloc()63 !!----------------------------------------------------------------------64 !! *** ROUTINE trc_sms_cfc_alloc ***65 !!----------------------------------------------------------------------66 INTEGER :: trc_sms_cfc_alloc67 !!----------------------------------------------------------------------68 69 ALLOCATE(xphem(jpi,jpj), &70 qtr_cfc(jpi,jpj,jp_cfc), &71 qint_cfc(jpi,jpj,jp_cfc), &72 Stat=trc_sms_cfc_alloc)73 74 IF(trc_sms_cfc_alloc /= 0)THEN75 CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.')76 END IF77 78 END FUNCTION trc_sms_cfc_alloc79 80 62 81 63 SUBROUTINE trc_sms_cfc( kt ) … … 115 97 !!---------------------------------------------------------------------- 116 98 117 IF( wrk_in_use(3, 1))THEN99 IF( wrk_in_use(3, 1) ) THEN 118 100 CALL ctl_stop('trc_sms_cfc : requested workspace array unavailable.') 119 101 RETURN … … 202 184 #if defined key_diatrc 203 185 ! Save diagnostics , just for CFC11 204 # if ! defined key_iomput 186 # if defined key_iomput 187 CALL iom_put( "qtrCFC11" , qtr_cfc (:,:,1) ) 188 CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 189 # else 205 190 trc2d(:,:,jp_cfc0_2d ) = qtr_cfc (:,:,1) 206 191 trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 207 # else208 CALL iom_put( "qtrCFC11" , qtr_cfc (:,:,1) )209 CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) )210 192 # endif 211 193 #endif … … 218 200 END IF 219 201 220 IF(wrk_not_released(3, 1))THEN 221 CALL ctl_stop('trc_sms_cfc : failed to release workspace array.') 222 END IF 202 IF( wrk_not_released(3, 1) ) CALL ctl_stop('trc_sms_cfc : failed to release workspace array.') 223 203 224 204 END SUBROUTINE trc_sms_cfc … … 272 252 END SUBROUTINE trc_cfc_cst 273 253 254 INTEGER FUNCTION trc_sms_cfc_alloc() 255 !!---------------------------------------------------------------------- 256 !! *** ROUTINE trc_sms_cfc_alloc *** 257 !!---------------------------------------------------------------------- 258 259 ALLOCATE( xphem(jpi,jpj) , & 260 & qtr_cfc(jpi,jpj,jp_cfc) , & 261 & qint_cfc(jpi,jpj,jp_cfc), & 262 & STAT=trc_sms_cfc_alloc ) 263 264 IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.') 265 266 END FUNCTION trc_sms_cfc_alloc 267 274 268 #else 275 269 !!---------------------------------------------------------------------- -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/LOBSTER/sms_lobster.F90
r2636 r2643 112 112 !! *** ROUTINE sms_lobster_alloc *** 113 113 !!---------------------------------------------------------------------- 114 USE lib_mpp, ONLY: ctl_warn 114 USE lib_mpp, ONLY: ctl_warn ! MPP library 115 INTEGER :: ierr(3) ! Local variables 115 116 !!---------------------------------------------------------------------- 116 ! 117 ALLOCATE( remdmp(jpk,jp_lobster), & 118 & neln(jpi,jpj), xze(jpi,jpj), xpar(jpi,jpj,jpk), & 119 & dminl(jpi,jpj), dmin3(jpi,jpj,jpk), & 120 & sedpocb(jpi,jpj), sedpocn(jpi,jpj), sedpoca(jpi,jpj), & 121 & fbod(jpi,jpj), cmask(jpi,jpj) , STAT=sms_lobster_alloc ) 122 ! 123 IF( sms_lobster_alloc /= 0 ) CALL ctl_warn('sms_lobster_alloc : failed to allocate arrays') 124 ! 117 118 ierr(:) = 0 119 !* Biological parameters 120 ALLOCATE( remdmp(jpk,jp_lobster), STAT=ierr(1) ) 121 122 !* Optical parameters 123 ALLOCATE( neln(jpi,jpj) , xze(jpi,jpj), & 124 & xpar(jpi,jpj,jpk) , STAT=ierr(2) ) 125 126 !* Sediment parameters 127 ALLOCATE( dminl(jpi,jpj) , dmin3(jpi,jpj,jpk), & 128 & sedpocb(jpi,jpj), sedpocn(jpi,jpj) , sedpoca(jpi,jpj), & 129 & fbod(jpi,jpj) , cmask(jpi,jpj) , STAT=ierr(3) ) 130 131 sms_lobster_alloc = MAXVAL( ierr ) 132 133 IF( sms_lobster_alloc /= 0 ) CALL ctl_warn('sms_lobster_alloc : failed to allocate arrays.') 134 125 135 END FUNCTION sms_lobster_alloc 126 136 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90
r2633 r2643 86 86 87 87 #if defined key_diatrc && defined key_iomput 88 IF( wrk_in_use(3, 2) .OR. wrk_in_use(4, 1) )THEN88 IF( ( wrk_in_use(3, 2) ) .OR. ( wrk_in_use(4, 1) ) ) THEN 89 89 CALL ctl_stop('trc_bio : requested workspace arrays unavailable.') 90 90 RETURN … … 103 103 fbod(:,:) = 0.e0 104 104 #if defined key_diatrc && ! defined key_iomput 105 # if defined key_iomput 106 zw2d (:,:,:) = 0.e0 107 zw3d(:,:,:,:) = 0.e0 108 # else 105 109 DO jl = jp_lob0_2d, jp_lob1_2d 106 110 trc2d(:,:,jl) = 0.e0 107 111 END DO 108 #endif 109 #if defined key_diatrc && defined key_iomput 110 zw2d(:,:,:) = 0.e0 111 zw3d(:,:,:,:) = 0.e0 112 # endif 112 113 #endif 113 114 … … 500 501 ! 501 502 #if defined key_diatrc && defined key_iomput 502 IF( wrk_not_released(3, 2) .OR. wrk_not_released(4, 1) )THEN 503 CALL ctl_stop('trc_bio : failed to release workspace arrays.') 504 END IF 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 505 #endif 506 506 ! -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90
r2528 r2643 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 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90
r2633 r2643 21 21 USE trc 22 22 USE lbclnk 23 USE lib_mpp24 USE lib_fortran25 23 26 24 IMPLICIT NONE … … 50 48 !!---------------------------------------------------------------------- 51 49 52 IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1) )THEN53 CALL ctl_stop('trc_ini_lobster : requested workspace arrays unavailable.')54 RETURN55 END IF56 57 ! Control consitency58 CALL trc_ctl_lobster59 60 61 50 IF(lwp) WRITE(numout,*) 62 51 IF(lwp) WRITE(numout,*) ' trc_ini_lobster : LOBSTER biochemical model initialisation' 63 52 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~' 53 54 55 CALL lobster_alloc() ! Allocate LOBSTER arrays 56 57 IF( ( wrk_in_use(2, 1) ) .OR. ( wrk_in_use(3, 1) ) ) THEN 58 CALL ctl_stop('trc_ini_lobster : requested workspace arrays unavailable.') ; RETURN 59 ENDIF 60 64 61 65 62 ! initialization of fields for optical model … … 144 141 ! Coastal surface 145 142 ! --------------- 146 areacot = glob_sum( e1 t(:,:) *e2t(:,:) * cmask(:,:) )143 areacot = glob_sum( e1e2t(:,:) * cmask(:,:) ) 147 144 148 145 ! Initialization of tracer concentration in case of no restart … … 226 223 trn(:,:,30,jp_lob_no3) = 20.01 * tmask(:,:,30) 227 224 228 # elif defined key_gyre 225 226 # elif defined key_gyre || defined key_orca_r2 229 227 ! LOBSTER initialisation for GYRE 230 228 ! ---------------------- … … 259 257 IF(lwp) WRITE(numout,*) ' ' 260 258 261 IF( wrk_not_released(2, 1) .OR. wrk_not_released(3, 1) )THEN 262 CALL ctl_stop('trc_ini_lobster : failed to release workspace arrays.') 263 END IF 259 IF( ( wrk_not_released(2, 1) ) .OR. ( wrk_not_released(3, 1) ) ) & 260 & CALL ctl_stop('trc_ini_lobster : failed to release workspace arrays.') 264 261 265 262 END SUBROUTINE trc_ini_lobster 266 263 267 SUBROUTINE trc_ctl_lobster268 !!---------------------------------------------------------------------- 269 !! *** ROUTINE trc_ctl_lobster***264 SUBROUTINE lobster_alloc 265 !!---------------------------------------------------------------------- 266 !! *** ROUTINE lobster_alloc *** 270 267 !! 271 !! ** Purpose : control the cpp options, namelist and files 272 !!---------------------------------------------------------------------- 273 INTEGER :: jl, jn 274 275 IF(lwp) WRITE(numout,*) 276 IF(lwp) WRITE(numout,*) ' use LOBSTER biological model ' 277 278 ! Check number of tracers 279 ! ----------------------- 280 IF( jp_lobster /= 6 ) CALL ctl_stop( ' LOBSTER has 6 passive tracers. Change jp_lobster in par_lobster.F90' ) 281 282 ! Check tracer names 283 ! ------------------ 284 IF( ctrcnm(jp_lob_det) /= 'DET' .OR. ctrcnm(jp_lob_zoo) /= 'ZOO' .OR. & 285 & ctrcnm(jp_lob_phy) /= 'PHY' .OR. ctrcnm(jp_lob_no3) /= 'NO3' .OR. & 286 & ctrcnm(jp_lob_nh4) /= 'NH4' .OR. ctrcnm(jp_lob_dom) /= 'DOM' .OR. & 287 & ctrcnl(jp_lob_det) /= 'Detritus' .OR. & 288 & ctrcnl(jp_lob_zoo) /= 'Zooplankton concentration' .OR. & 289 & ctrcnl(jp_lob_phy) /= 'Phytoplankton concentration' .OR. & 290 & ctrcnl(jp_lob_no3) /= 'Nitrate concentration' .OR. & 291 & ctrcnl(jp_lob_nh4) /= 'Ammonium concentration' .OR. & 292 & ctrcnl(jp_lob_dom) /= 'Dissolved organic matter' ) THEN 293 ctrcnm(jp_lob_det)='DET' 294 ctrcnl(jp_lob_det)='Detritus' 295 ctrcnm(jp_lob_zoo)='ZOO' 296 ctrcnl(jp_lob_zoo)='Zooplankton concentration' 297 ctrcnm(jp_lob_phy)='PHY' 298 ctrcnl(jp_lob_phy)='Phytoplankton concentration' 299 ctrcnm(jp_lob_no3)='NO3' 300 ctrcnl(jp_lob_no3)='Nitrate concentration' 301 ctrcnm(jp_lob_nh4)='NH4' 302 ctrcnl(jp_lob_nh4)='Ammonium concentration' 303 ctrcnm(jp_lob_dom)='DOM' 304 ctrcnl(jp_lob_dom)='Dissolved organic matter' 305 IF(lwp) THEN 306 CALL ctl_warn( ' We force tracer names ' ) 307 DO jl = 1, jp_lobster 308 jn = jp_lob0 + jl - 1 309 WRITE(numout,*) ' tracer nb: ',jn,' name = ',ctrcnm(jn), ctrcnl(jn) 310 END DO 311 WRITE(numout,*) ' ' 312 ENDIF 313 ENDIF 314 315 ! Check tracer units 316 DO jl = 1, jp_lobster 317 jn = jp_lob0 + jl - 1 318 IF( ctrcun(jn) /= 'mmole-N/m3') THEN 319 ctrcun(jn) = 'mmole-N/m3' 320 IF(lwp) THEN 321 CALL ctl_warn( ' We force tracer units ' ) 322 WRITE(numout,*) ' tracer ',ctrcnm(jn), 'UNIT= ',ctrcun(jn) 323 ENDIF 324 ENDIF 325 END DO 326 327 END SUBROUTINE trc_ctl_lobster 268 !! ** Purpose : Allocate all the dynamic arrays of LOBSTER 269 !!---------------------------------------------------------------------- 270 271 ! ! Allocate LOBSTER arrays 272 IF( sms_lobster_alloc() /= 0 ) & 273 & CALL ctl_stop( 'STOP', 'trc_ini_lobster : unable to allocate LOBSTER arrays' ) 274 ! 275 END SUBROUTINE lobster_alloc 328 276 329 277 #else -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcnam_lobster.F90
r2636 r2643 16 16 USE trc ! TOP variables 17 17 USE sms_lobster ! sms trends 18 USE in_out_manager ! I/O manager19 USE lib_mpp ! MPP library20 18 21 19 IMPLICIT NONE -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcopt.F90
r2636 r2643 21 21 USE sms_lobster 22 22 USE prtctl_trc ! Print control for debbuging 23 USE lib_mpp ! MPP library24 23 25 24 IMPLICIT NONE … … 69 68 !!--------------------------------------------------------------------- 70 69 71 IF( ( wrk_in_use(2, 1,2)) .OR. (wrk_in_use(3, 2,3)) )THEN70 IF( ( wrk_in_use(2, 1,2)) .OR. ( wrk_in_use(3, 2,3)) )THEN 72 71 CALL ctl_stop('trc_opt : requested workspace arrays unavailable') ; RETURN 73 72 END IF -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcrst_lobster.F90
r2528 r2643 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 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90
r2633 r2643 69 69 !!--------------------------------------------------------------------- 70 70 71 IF( ( wrk_in_use(3,2)) .OR. (wrk_in_use(2,1)) )THEN71 IF( ( wrk_in_use(3,2)) .OR. ( wrk_in_use(2,1)) ) THEN 72 72 CALL ctl_stop('trc_sed : requested workspace arrays unavailable.') 73 73 RETURN … … 150 150 ENDIF 151 151 152 IF( (wrk_not_released(3,2)) .OR. (wrk_not_released(2,1)) )THEN 153 CALL ctl_stop('trc_sed : failed to release workspace arrays.') 154 END IF 152 IF( ( wrk_not_released(3, 2) ) .OR. ( wrk_not_released(2, 1) ) ) & 153 & CALL ctl_stop('trc_sed : failed to release workspace arrays.') 155 154 156 155 END SUBROUTINE trc_sed -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsms_lobster.F90
r2636 r2643 23 23 USE trdmod_trc 24 24 USE trdmld_trc 25 USE lib_mpp ! MPP library26 25 27 26 IMPLICIT NONE … … 53 52 !! -------------------------------------------------------------------- 54 53 55 IF( wrk_in_use(3, 1) ) THEN54 IF( wrk_in_use(3, 1) ) THEN 56 55 CALL ctl_stop('trc_sms_lobster : requested workspace array unavailable') ; RETURN 57 56 ENDIF … … 71 70 IF( lk_trdmld_trc ) CALL trd_mld_bio( kt ) ! trends: Mixed-layer 72 71 73 IF( wrk_not_released(3, 1) ) CALL ctl_stop('trc_sms_lobster : failed to release workspace array.')72 IF( wrk_not_released(3, 1) ) CALL ctl_stop('trc_sms_lobster : failed to release workspace array.') 74 73 ! 75 74 END SUBROUTINE trc_sms_lobster -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90
r2528 r2643 38 38 !!---------------------------------------------------------------------- 39 39 40 ! Control consitency 41 CALL trc_ctl_my_trc 40 CALL my_trc_alloc() ! Allocate MY_TRC arrays 41 42 CALL trc_ctl_my_trc ! Control consitency 42 43 43 44 IF(lwp) WRITE(numout,*) … … 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' … … 71 72 72 73 END SUBROUTINE trc_ctl_my_trc 74 75 SUBROUTINE my_trc_alloc 76 !!---------------------------------------------------------------------- 77 !! *** ROUTINE my_trc_alloc *** 78 !! 79 !! ** Purpose : Allocate all the dynamic arrays of MY_TRC 80 !!---------------------------------------------------------------------- 81 82 ! ! Allocate MY_TRC arrays 83 ! 84 END SUBROUTINE my_trc_alloc 73 85 74 86 #else -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zbio.F90
r2528 r2643 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 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90
r2528 r2643 25 25 26 26 PUBLIC p4z_che 27 PUBLIC p4z_che_alloc 27 28 28 29 !! * 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 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 34 33 35 34 !! * Module variables … … 156 155 CONTAINS 157 156 157 158 158 SUBROUTINE p4z_che 159 159 !!--------------------------------------------------------------------- … … 324 324 END SUBROUTINE p4z_che 325 325 326 INTEGER FUNCTION p4z_che_alloc() 327 !!---------------------------------------------------------------------- 328 !! *** ROUTINE p4z_che_alloc *** 329 !!---------------------------------------------------------------------- 330 331 ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), & 332 & chemc(jpi,jpj,2), STAT=p4z_che_alloc ) 333 334 IF( p4z_che_alloc /= 0 ) CALL ctl_warn('p4z_che_alloc : failed to allocate arrays.') 335 336 END FUNCTION p4z_che_alloc 326 337 #else 327 338 !!====================================================================== -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90
r2528 r2643 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 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 40 REAL(wp) :: t_oce_co2_flx !: Total ocean carbon flux 41 41 REAL(wp) :: t_atm_co2_flx !: global mean of atmospheric pco2 … … 63 63 !! ** Method : - ??? 64 64 !!--------------------------------------------------------------------- 65 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 66 USE wrk_nemo, ONLY: zkgco2 => wrk_2d_1, zkgo2 => wrk_2d_2, zh2co3 => wrk_2d_3 67 USE wrk_nemo, ONLY: zoflx => wrk_2d_4, zkg => wrk_2d_5 68 USE wrk_nemo, ONLY: zdpco2 => wrk_2d_6, zdpo2 => wrk_2d_7 69 ! 65 70 INTEGER, INTENT(in) :: kt 66 71 INTEGER :: ji, jj, jrorr … … 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 79 IF( wrk_in_use(2, 1,2,3,4,5,6,7) ) THEN 80 CALL ctl_stop('p4z_flx: requested workspace arrays unavailable') ; RETURN 81 END IF 77 82 78 83 ! SURFACE CHEMISTRY (PCO2 AND [H+] IN … … 149 154 zfld = satmco2(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj) 150 155 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. 156 oce_co2(ji,jj) = ( zfld - zflu ) * rfact * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 153 157 ! compute the trend 154 158 tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) / fse3t(ji,jj,1) … … 162 166 ! Save diagnostics 163 167 # if ! defined key_iomput 164 zfact = 1. / ( e1t(ji,jj) * e2t(ji,jj)) / rfact168 zfact = 1. / e1e2t(ji,jj) / rfact 165 169 trc2d(ji,jj,jp_pcs0_2d ) = oce_co2(ji,jj) * zfact 166 170 trc2d(ji,jj,jp_pcs0_2d + 1) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1) … … 180 184 t_oce_co2_flx = t_oce_co2_flx + glob_sum( oce_co2(:,:) ) ! Cumulative Total Flux of Carbon 181 185 IF( kt == nitend ) THEN 182 t_atm_co2_flx = glob_sum( satmco2(:,:) * e1 t(:,:) *e2t(:,:) ) ! Total atmospheric pCO2186 t_atm_co2_flx = glob_sum( satmco2(:,:) * e1e2t(:,:) ) ! Total atmospheric pCO2 183 187 ! 184 188 t_oce_co2_flx = (-1.) * t_oce_co2_flx * 12. / 1.e15 ! Conversion in PgC ; negative for out of the ocean … … 203 207 204 208 # if defined key_diatrc && defined key_iomput 205 CALL iom_put( "Cflx" , oce_co2(:,:) / ( e1t(:,:) * e2t(:,:) ) / rfact )209 CALL iom_put( "Cflx" , oce_co2(:,:) / e1e2t(:,:) / rfact 206 210 CALL iom_put( "Oflx" , zoflx ) 207 211 CALL iom_put( "Kg" , zkg ) … … 210 214 #endif 211 215 216 IF( wrk_not_released(2, 1,2,3,4,5,6,7) ) CALL ctl_stop('p4z_flx: failed to release workspace arrays') 217 ! 212 218 END SUBROUTINE p4z_flx 213 219 … … 238 244 239 245 ! interior global domain surface 240 area = glob_sum( e1 t(:,:) *e2t(:,:) )246 area = glob_sum( e1e2t(:,:) ) 241 247 242 248 ! Initialization of Flux of Carbon … … 249 255 END SUBROUTINE p4z_flx_init 250 256 257 INTEGER FUNCTION p4z_flx_alloc() 258 !!---------------------------------------------------------------------- 259 !! *** ROUTINE p4z_flx_alloc *** 260 !!---------------------------------------------------------------------- 261 262 ALLOCATE( oce_co2(jpi,jpj), satmco2(jpi,jpj), STAT=p4z_flx_alloc ) 263 264 IF( p4z_flx_alloc /= 0 ) CALL ctl_warn('p4z_flx_alloc : failed to allocate arrays.') 265 266 END FUNCTION p4z_flx_alloc 267 251 268 #else 252 269 !!====================================================================== -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zint.F90
r2528 r2643 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 28 !! * Module variables 29 REAL(wp) :: & 30 xksilim = 16.5E-6 ! Half-saturation constant for the computation of the Si half-saturation constant 29 REAL(wp) :: xksilim = 16.5E-6 ! Half-saturation constant for the computation of the Si half-saturation constant 31 30 32 31 … … 76 75 END SUBROUTINE p4z_int 77 76 77 INTEGER FUNCTION p4z_int_alloc() 78 !!---------------------------------------------------------------------- 79 !! *** ROUTINE p4z_int_alloc *** 80 !!---------------------------------------------------------------------- 81 82 ALLOCATE( tgfunc(jpi,jpj,jpk), tgfunc2(jpi,jpj,jpk), STAT=p4z_int_alloc ) 83 84 IF( p4z_int_alloc /= 0 ) CALL ctl_warn('p4z_int_alloc : failed to allocate arrays.') 85 86 END FUNCTION p4z_int_alloc 87 78 88 #else 79 89 !!====================================================================== -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90
r2528 r2643 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 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90
r2528 r2643 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 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 29 30 30 31 INTEGER :: nksrp ! levels below which the light cannot penetrate ( depth larger than 391 m) … … 43 44 CONTAINS 44 45 46 45 47 SUBROUTINE p4z_opt( kt, jnt ) 46 48 !!--------------------------------------------------------------------- … … 52 54 !! ** Method : - ??? 53 55 !!--------------------------------------------------------------------- 56 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 57 USE wrk_nemo, ONLY: zdepmoy => wrk_2d_1, zetmp => wrk_2d_2 58 USE wrk_nemo, ONLY: zekg => wrk_3d_2, zekr => wrk_3d_3, zekb => wrk_3d_4 59 USE wrk_nemo, ONLY: ze0 => wrk_3d_5, ze1 => wrk_3d_6 60 USE wrk_nemo, ONLY: ze2 => wrk_3d_7, ze3 => wrk_3d_8 61 ! 54 62 INTEGER, INTENT(in) :: kt, jnt ! ocean time step 55 63 INTEGER :: ji, jj, jk … … 57 65 REAL(wp) :: zchl, zxsi0r 58 66 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 67 !!--------------------------------------------------------------------- 63 68 69 IF( ( wrk_in_use(2, 1,2) ) .OR. ( wrk_in_use(3, 2,3,4,5,6,7,8) ) ) THEN 70 CALL ctl_stop('p4z_opt: requested workspace arrays unavailable') ; RETURN 71 END IF 64 72 65 73 ! Initialisation of variables used to compute PAR … … 223 231 #endif 224 232 ! 233 IF( ( wrk_not_released(2, 1,2) ) .OR. ( wrk_not_released(3, 2,3,4,5,6,7,8) ) ) & 234 & CALL ctl_stop('p4z_opt: failed to release workspace arrays') 235 ! 225 236 END SUBROUTINE p4z_opt 226 237 … … 245 256 ! 246 257 END SUBROUTINE p4z_opt_init 258 259 INTEGER FUNCTION p4z_opt_alloc() 260 !!---------------------------------------------------------------------- 261 !! *** ROUTINE p4z_opt_alloc *** 262 !!---------------------------------------------------------------------- 263 264 ALLOCATE( etot (jpi,jpj,jpk), enano(jpi,jpj,jpk), & 265 & ediat(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc ) 266 267 IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.') 268 269 END FUNCTION p4z_opt_alloc 270 247 271 #else 248 272 !!---------------------------------------------------------------------- -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90
r2528 r2643 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 29 PUBLIC p4z_prod_alloc 32 30 33 31 !! * Shared module variables … … 43 41 grosip = 0.151_wp 44 42 45 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: prmax43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prmax 46 44 47 45 REAL(wp) :: & … … 61 59 CONTAINS 62 60 61 63 62 SUBROUTINE p4z_prod( kt , jnt ) 64 63 !!--------------------------------------------------------------------- … … 70 69 !! ** Method : - ??? 71 70 !!--------------------------------------------------------------------- 71 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 72 USE wrk_nemo, ONLY: zmixnano => wrk_2d_1 , zmixdiat => wrk_2d_2, zstrn => wrk_2d_3 73 USE wrk_nemo, ONLY: zpislopead => wrk_3d_2 , zpislopead2 => wrk_3d_2 74 USE wrk_nemo, ONLY: zprdia => wrk_3d_4 , zprbio => wrk_3d_5, zysopt => wrk_3d_6 75 USE wrk_nemo, ONLY: zprorca => wrk_3d_7 , zprorcad => wrk_3d_8 76 USE wrk_nemo, ONLY: zprofed => wrk_3d_9 , zprofen => wrk_3d_10 77 USE wrk_nemo, ONLY: zprochln => wrk_3d_11, zprochld => wrk_3d_12 78 USE wrk_nemo, ONLY: zpronew => wrk_3d_13, zpronewd => wrk_3d_14 79 ! 72 80 INTEGER, INTENT(in) :: kt, jnt 73 81 INTEGER :: ji, jj, jk … … 81 89 REAL(wp) :: zrfact2 82 90 #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 91 CHARACTER (len=25) :: charout 90 92 !!--------------------------------------------------------------------- 93 94 IF( ( wrk_in_use(2, 1,2,3) ) .OR. ( wrk_in_use(3, 2,3,4,5,6,7,8,9,10,11,12,13,14) ) ) THEN 95 CALL ctl_stop('p4z_prod: requested workspace arrays unavailable') ; RETURN 96 END IF 91 97 92 98 zprorca (:,:,:) = 0.0 … … 187 193 zsilfac = MIN( 6.4,zsilfac * zsilfac2) 188 194 zysopt(ji,jj,jk) = grosip * zlim1 * zsilfac 189 190 195 ENDIF 191 196 END DO … … 363 368 ENDIF 364 369 370 IF( ( wrk_not_released(2, 1,2,3) ) .OR. ( wrk_not_released(3, 2,3,4,5,6,7,8,9,10,11,12,13,14) ) ) & 371 & CALL ctl_stop('p4z_prod: failed to release workspace arrays') 372 ! 365 373 END SUBROUTINE p4z_prod 366 374 … … 408 416 409 417 418 INTEGER FUNCTION p4z_prod_alloc() 419 !!---------------------------------------------------------------------- 420 !! *** ROUTINE p4z_prod_alloc *** 421 !!---------------------------------------------------------------------- 422 423 ALLOCATE( prmax(jpi,jpj,jpk), STAT=p4z_prod_alloc ) 424 425 IF( p4z_prod_alloc /= 0 ) CALL ctl_warn('p4z_prod_alloc : failed to allocate arrays.') 426 427 END FUNCTION p4z_prod_alloc 410 428 411 429 #else -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90
r2528 r2643 29 29 PUBLIC p4z_rem ! called in p4zbio.F90 30 30 PUBLIC p4z_rem_init ! called in trcsms_pisces.F90 31 PUBLIC p4z_rem_alloc 31 32 32 33 !! * Shared module variables … … 39 40 oxymin = 1.e-6_wp !: 40 41 41 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 42 & denitr !: denitrification array 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitr !: denitrification array 43 43 44 44 … … 53 53 CONTAINS 54 54 55 55 56 SUBROUTINE p4z_rem( kt ) 56 57 !!--------------------------------------------------------------------- … … 61 62 !! ** Method : - ??? 62 63 !!--------------------------------------------------------------------- 64 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 65 USE wrk_nemo, ONLY: ztempbac => wrk_2d_1 66 USE wrk_nemo, ONLY: zdepbac => wrk_3d_2, zfesatur => wrk_3d_2, zolimi => wrk_3d_4 67 ! 63 68 INTEGER, INTENT(in) :: kt ! ocean time step 64 69 INTEGER :: ji, jj, jk … … 72 77 #endif 73 78 REAL(wp) :: zlamfac, zonitr, zstep 74 REAL(wp), DIMENSION(jpi,jpj) :: ztempbac75 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepbac, zfesatur, zolimi76 79 CHARACTER (len=25) :: charout 77 80 78 81 !!--------------------------------------------------------------------- 79 82 83 IF( ( wrk_in_use(2, 1) ) .OR. ( wrk_in_use(3, 2,3,4) ) ) THEN 84 CALL ctl_stop('p4z_rem: requested workspace arrays unavailable') ; RETURN 85 END IF 80 86 81 87 ! Initialisation of temprary arrys … … 393 399 ENDIF 394 400 401 IF( ( wrk_not_released(2, 1) ) .OR. ( wrk_not_released(3, 2,3,4) ) ) & 402 & CALL ctl_stop('p4z_rem: failed to release workspace arrays') 403 395 404 END SUBROUTINE p4z_rem 396 405 … … 431 440 END SUBROUTINE p4z_rem_init 432 441 442 INTEGER FUNCTION p4z_rem_alloc() 443 !!---------------------------------------------------------------------- 444 !! *** ROUTINE p4z_rem_alloc *** 445 !!---------------------------------------------------------------------- 446 447 ALLOCATE( denitr(jpi,jpj,jpk), STAT=p4z_rem_alloc ) 448 449 IF( p4z_rem_alloc /= 0 ) CALL ctl_warn('p4z_rem_alloc : failed to allocate arrays.') 450 451 END FUNCTION p4z_rem_alloc 433 452 #else 434 453 !!====================================================================== -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90
r2528 r2643 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 !!====================================================================== -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90
r2528 r2643 21 21 PUBLIC p4z_sink ! called in p4zbio.F90 22 22 PUBLIC p4z_sink_init ! called in trcsms_pisces.F90 23 PUBLIC p4z_sink_alloc 23 24 24 25 !! * Shared module variables 25 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !:26 wsbio3, wsbio4, & !: POC and GOC sinking speeds27 wscal!: Calcite and BSi sinking speeds26 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wsbio3 !: POC sinking speed 27 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wsbio4 !: GOC sinking speed 28 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wscal !: Calcite and BSi sinking speeds 28 29 29 30 !! * 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 ! 31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinking, sinking2 !: POC sinking fluxes 32 ! ! (different meanings depending on the parameterization) 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkcal, sinksil !: CaCO3 and BSi sinking fluxes 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkfer !: Small BFe sinking fluxes 35 #if ! defined key_kriest 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkfer2 !: Big iron sinking fluxes 37 #endif 38 39 INTEGER :: iksed = 10 37 40 38 41 #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 42 REAL(wp) :: xkr_sfact = 250. !: Sinking factor 43 REAL(wp) :: xkr_stick = 0.2 !: Stickiness 44 REAL(wp) :: xkr_nnano = 2.337 !: Nbr of cell in nano size class 45 REAL(wp) :: xkr_ndiat = 3.718 !: Nbr of cell in diatoms size class 46 REAL(wp) :: xkr_nmeso = 7.147 !: Nbr of cell in mesozoo size class 47 REAL(wp) :: xkr_naggr = 9.877 !: Nbr of cell in aggregates size class 48 49 REAL(wp) :: xkr_frac 50 51 REAL(wp), PUBLIC :: xkr_dnano !: Size of particles in nano pool 52 REAL(wp), PUBLIC :: xkr_ddiat !: Size of particles in diatoms pool 53 REAL(wp), PUBLIC :: xkr_dmeso !: Size of particles in mesozoo pool 54 REAL(wp), PUBLIC :: xkr_daggr !: Size of particles in aggregates pool 55 REAL(wp), PUBLIC :: xkr_wsbio_min !: min vertical particle speed 56 REAL(wp), PUBLIC :: xkr_wsbio_max !: max vertical particle speed 57 58 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: xnumm !: maximum number of particles in aggregates 59 #endif 67 60 68 61 !!* Substitution … … 76 69 CONTAINS 77 70 71 78 72 #if defined key_kriest 79 73 … … 87 81 !! ** Method : - ??? 88 82 !!--------------------------------------------------------------------- 89 83 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 84 USE wrk_nemo, ONLY: znum3d => wrk_3d_2 90 85 INTEGER, INTENT(in) :: kt, jnt 91 86 INTEGER :: ji, jj, jk … … 99 94 INTEGER :: ik1 100 95 #endif 101 REAL(wp), DIMENSION(jpi,jpj,jpk) :: znum3d102 96 CHARACTER (len=25) :: charout 103 97 104 98 !!--------------------------------------------------------------------- 105 99 100 IF( wrk_in_use(3, 2 ) ) THEN 101 CALL ctl_stop('p4z_sink: requested workspace arrays unavailable') ; RETURN 102 END IF 106 103 ! Initialisation of variables used to compute Sinking Speed 107 104 ! --------------------------------------------------------- … … 311 308 ENDIF 312 309 310 IF( wrk_not_released(3, 2 ) ) CALL ctl_stop('p4z_sink: failed to release workspace arrays') 311 ! 313 312 END SUBROUTINE p4z_sink 314 313 … … 611 610 !! transport term, i.e. div(u*tra). 612 611 !!--------------------------------------------------------------------- 612 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 613 USE wrk_nemo, ONLY: ztraz => wrk_3d_2, zakz => wrk_3d_3, zwsink2 => wrk_3d_4 614 ! 613 615 INTEGER , INTENT(in ) :: jp_tra ! tracer index index 614 616 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pwsink ! sinking speed … … 617 619 INTEGER :: ji, jj, jk, jn 618 620 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 621 !!--------------------------------------------------------------------- 622 623 IF( wrk_in_use(3, 2,3,4 ) ) THEN 624 CALL ctl_stop('p4z_sink2: requested workspace arrays unavailable') 625 RETURN 626 END IF 623 627 624 628 zstep = rfact2 / 2. … … 704 708 psinkflx(:,:,:) = 2. * psinkflx(:,:,:) 705 709 710 IF( wrk_not_released(3, 2,3,4 ) ) CALL ctl_stop('p4z_sink2: failed to release workspace arrays') 706 711 ! 707 712 END SUBROUTINE p4z_sink2 708 713 714 INTEGER FUNCTION p4z_sink_alloc() 715 !!---------------------------------------------------------------------- 716 !! *** ROUTINE p4z_sink_alloc *** 717 !!---------------------------------------------------------------------- 718 719 ALLOCATE( wsbio3(jpi,jpj,jpk), wsbio4(jpi,jpj,jpk), wscal(jpi,jpj,jpk), & 720 & sinking(jpi,jpj,jpk), sinking2(jpi,jpj,jpk) , & 721 & sinkcal(jpi,jpj,jpk), sinksil(jpi,jpj,jpk) , & 722 #if defined key_kriest 723 & xnumm(jpk) , & 724 #else 725 & sinkfer2(jpi,jpj,jpk) , & 726 #endif 727 728 & sinkfer(jpi,jpj,jpk), STAT=p4z_sink_alloc ) 729 730 IF( p4z_sink_alloc /= 0 ) CALL ctl_warn('p4z_sink_alloc : failed to allocate arrays.') 731 732 END FUNCTION p4z_sink_alloc 709 733 #else 710 734 !!====================================================================== -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90
r2528 r2643 38 38 !!* Damping 39 39 LOGICAL :: ln_pisdmp !: relaxation or not of nutrients to a mean value 40 !: when initialize from a restart file41 40 LOGICAL :: ln_pisclo !: Restoring or not of nutrients to initial value 42 41 !: on close seas 43 42 44 43 !!* 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 depth44 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: neln !: number of T-levels + 1 in the euphotic layer 45 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: heup !: euphotic layer depth 47 46 48 47 !!* 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 !: ???48 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: xksi !: ??? 49 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: xksimax !: ??? 50 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnanono3 !: ??? 51 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xdiatno3 !: ??? 52 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnanonh4 !: ??? 53 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xdiatnh4 !: ??? 54 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimphy !: ??? 55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimdia !: ??? 56 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: concdfe !: ??? 57 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: concnfe !: ??? 59 58 60 59 !!* 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 !: ??60 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xfracal !: ?? 61 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrfac !: ?? 62 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimbac !: ?? 63 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xdiss !: ?? 65 64 #if defined key_diatrc 66 REAL(wp), DIMENSION(jpi,jpj,jpk) :: prodcal !: Calcite production67 REAL(wp), DIMENSION(jpi,jpj,jpk) :: grazing !: Total zooplankton grazing65 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prodcal !: Calcite production 66 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: grazing !: Total zooplankton grazing 68 67 #endif 69 68 70 69 !!* 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 !: ??? 70 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akb3 !: ??? 71 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ak13 !: ??? 72 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ak23 !: ??? 73 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aksp !: ??? 74 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akw3 !: ??? 75 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: borat !: ??? 76 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hi !: ??? 77 78 !!* Array used to indicate negative tracer values 79 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnegtr !: ??? 78 80 79 81 #if defined key_kriest … … 84 86 REAL(wp) :: xkr_mass_min, xkr_mass_max !: ??? 85 87 #endif 88 89 CONTAINS 90 91 INTEGER FUNCTION sms_pisces_alloc() 92 !!---------------------------------------------------------------------- 93 !! *** ROUTINE sms_pisces_alloc *** 94 !!---------------------------------------------------------------------- 95 USE lib_mpp , ONLY: ctl_warn 96 INTEGER :: ierr(5) ! Local variables 97 !!---------------------------------------------------------------------- 98 99 ierr(:) = 0 100 101 !* Biological fluxes for light 102 ALLOCATE( neln(jpi,jpj), heup(jpi,jpj), STAT=ierr(1) ) 103 104 !* Biological fluxes for primary production 105 ALLOCATE( xksimax(jpi,jpj) , xksi(jpi,jpj) , & 106 & xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk), & 107 & xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk), & 108 & xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk), & 109 & concdfe (jpi,jpj,jpk), concnfe (jpi,jpj,jpk), STAT=ierr(2) ) 110 111 !* SMS for the organic matter 112 ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac (jpi,jpj,jpk), & 113 #if defined key_diatrc 114 & prodcal(jpi,jpj,jpk) , grazing(jpi,jpj,jpk) , & 115 #endif 116 & xlimbac (jpi,jpj,jpk), xdiss(jpi,jpj,jpk) , STAT=ierr(3) ) 117 118 !* Variable for chemistry of the CO2 cycle 119 ALLOCATE( akb3(jpi,jpj,jpk), ak13(jpi,jpj,jpk) , & 120 & ak23(jpi,jpj,jpk), aksp(jpi,jpj,jpk) , & 121 & akw3(jpi,jpj,jpk), borat(jpi,jpj,jpk), hi(jpi,jpj,jpk), STAT=ierr(4) ) 122 123 !* Array used to indicate negative tracer values 124 ALLOCATE( xnegtr(jpi,jpj,jpk), STAT=ierr(5) ) 125 126 sms_pisces_alloc = MAXVAL( ierr ) 127 128 IF( sms_pisces_alloc /= 0 ) CALL ctl_warn('sms_pisces_alloc : failed to allocate arrays.') 129 130 END FUNCTION sms_pisces_alloc 86 131 87 132 #else -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
r2528 r2643 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 … … 29 35 30 36 !! * 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 37 REAL(wp) :: sco2 = 2.312e-3 38 REAL(wp) :: alka0 = 2.423e-3 39 REAL(wp) :: oxyg0 = 177.6e-6 40 REAL(wp) :: po4 = 2.174e-6 41 REAL(wp) :: bioma0 = 1.000e-8 42 REAL(wp) :: silic1 = 91.65e-6 43 REAL(wp) :: no3 = 31.04e-6 * 7.6 39 44 40 45 # include "top_substitute.h90" … … 55 60 56 61 57 ! Control consitency58 CALL trc_ctl_pisces59 60 61 62 IF(lwp) WRITE(numout,*) 62 63 IF(lwp) WRITE(numout,*) ' trc_ini_pisces : PISCES biochemical model initialisation' 63 64 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 65 66 67 CALL pisces_alloc() ! Allocate PISCES arrays 64 68 65 69 ! ! Time-step … … 129 133 ! 130 134 END SUBROUTINE trc_ini_pisces 131 132 SUBROUTINE trc_ctl_pisces135 136 SUBROUTINE pisces_alloc 133 137 !!---------------------------------------------------------------------- 134 !! *** ROUTINE trc_ctl_pisces***138 !! *** ROUTINE pisces_alloc *** 135 139 !! 136 !! ** Purpose : control the cpp options, namelist and files140 !! ** Purpose : Allocate all the dynamic arrays of PISCES 137 141 !!---------------------------------------------------------------------- 142 USE p4zint , ONLY : p4z_int_alloc 143 USE p4zsink, ONLY : p4z_sink_alloc 144 USE p4zopt , ONLY : p4z_opt_alloc 145 USE p4zprod, ONLY : p4z_prod_alloc 146 USE p4zrem , ONLY : p4z_rem_alloc 147 USE p4zsed , ONLY : p4z_sed_alloc 148 USE p4zflx , ONLY : p4z_flx_alloc 149 ! 150 INTEGER :: ierr 151 !!---------------------------------------------------------------------- 152 ! 153 ierr = sms_pisces_alloc() ! Start of PISCES-related alloc routines... 154 ierr = ierr + p4z_che_alloc() 155 ierr = ierr + p4z_int_alloc() 156 ierr = ierr + p4z_sink_alloc() 157 ierr = ierr + p4z_opt_alloc() 158 ierr = ierr + p4z_prod_alloc() 159 ierr = ierr + p4z_rem_alloc() 160 ierr = ierr + p4z_sed_alloc() 161 ierr = ierr + p4z_flx_alloc() 162 ! 163 IF( lk_mpp ) CALL mpp_sum( ierr ) 164 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'pisces_alloc : unable to allocate PISCES arrays' ) 138 165 139 IF(lwp) WRITE(numout,*)140 IF(lwp) WRITE(numout,*) ' use PISCES biological model '166 ! 167 END SUBROUTINE pisces_alloc 141 168 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 169 #else 153 170 !!---------------------------------------------------------------------- -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90
r2567 r2643 19 19 USE trc ! TOP variables 20 20 USE sms_pisces ! sms trends 21 USE in_out_manager ! I/O manager22 21 23 22 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90
r2528 r2643 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 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90
r2528 r2643 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 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/SED/sedini.F90
r2528 r2643 17 17 USE sedarr 18 18 USE iom 19 USE in_out_manager ! I/O manager20 19 21 20 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r2636 r2643 25 25 USE traadv_eiv ! eddy induced velocity (tra_adv_eiv routine) 26 26 USE ldftra_oce ! lateral diffusion coefficient on tracers 27 USE in_out_manager ! I/O manager28 USE lib_mpp ! MPP library29 27 USE prtctl_trc ! Print control 30 28 … … 50 48 CONTAINS 51 49 52 FUNCTION trc_adv_alloc()50 INTEGER FUNCTION trc_adv_alloc() 53 51 !!---------------------------------------------------------------------- 54 52 !! *** ROUTINE trc_adv_alloc *** 55 53 !!---------------------------------------------------------------------- 56 INTEGER :: trc_adv_alloc 57 !!---------------------------------------------------------------------- 58 59 ALLOCATE(r2dt(jpk), Stat=trc_adv_alloc) 60 61 IF(trc_adv_alloc /= 0)THEN 62 CALL ctl_warn('trc_adv_alloc : failed to allocate array.') 63 END IF 54 55 ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc ) 56 57 IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.') 64 58 65 59 END FUNCTION trc_adv_alloc … … 75 69 !!---------------------------------------------------------------------- 76 70 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 77 USE wrk_nemo, ONLY: zun => wrk_3d_ 1, zvn => wrk_3d_2, &78 zwn => wrk_3d_ 3! effective velocity71 USE wrk_nemo, ONLY: zun => wrk_3d_4, zvn => wrk_3d_5, & 72 zwn => wrk_3d_6 ! effective velocity 79 73 !! 80 74 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 84 78 !!---------------------------------------------------------------------- 85 79 86 IF( wrk_in_use(3, 1,2,3))THEN80 IF( wrk_in_use(3, 4,5,6) ) THEN 87 81 CALL ctl_stop('trc_adv : requested workspace arrays unavailable.') 88 82 RETURN … … 104 98 DO jk = 1, jpkm1 105 99 ! ! eulerian transport only 106 zun(:,:,jk) = e2u (:,:) * fse3u(:,:,jk) * un(:,:,jk)107 zvn(:,:,jk) = e1v (:,:) * fse3v(:,:,jk) * vn(:,:,jk)108 zwn(:,:,jk) = e1 t(:,:) * e2t(:,:)* wn(:,:,jk)100 zun(:,:,jk) = e2u (:,:) * fse3u(:,:,jk) * un(:,:,jk) 101 zvn(:,:,jk) = e1v (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 102 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 109 103 ! 110 104 END DO … … 150 144 END IF 151 145 ! 152 IF(wrk_not_released(3, 1,2,3))THEN 153 CALL ctl_stop('trc_adv : failed to release workspace arrays.') 154 END IF 146 IF( wrk_not_released(3, 4,5,6) ) CALL ctl_stop('trc_adv : failed to release workspace arrays.') 155 147 ! 156 148 END SUBROUTINE trc_adv -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r2528 r2643 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 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r2636 r2643 57 57 !! *** ROUTINE trc_nxt_alloc *** 58 58 !!---------------------------------------------------------------------- 59 USE lib_mpp, ONLY: ctl_warn60 !!----------------------------------------------------------------------61 59 ! 62 ALLOCATE( r2dt(jpk), S tat=trc_nxt_alloc)60 ALLOCATE( r2dt(jpk), STAT=trc_nxt_alloc) 63 61 ! 64 62 IF( trc_nxt_alloc /= 0 ) CALL ctl_warn('trc_nxt_alloc : failed to allocate array') -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r2528 r2643 17 17 USE trdmod_oce 18 18 USE trdtra 19 USE lib_mpp20 19 USE prtctl_trc ! Print control for debbuging 21 20 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r2636 r2643 21 21 USE trdmod_oce 22 22 USE trdtra 23 USE lib_mpp ! MPP library24 23 25 24 IMPLICIT NONE … … 59 58 !!---------------------------------------------------------------------- 60 59 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 61 USE wrk_nemo, zemps => wrk_2d_1 60 USE wrk_nemo, zemps => wrk_2d_1 61 USE wrk_nemo, ztrtrd => wrk_3d_1 62 62 ! 63 63 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 65 65 INTEGER :: ji, jj, jn ! dummy loop indices 66 66 REAL(wp) :: zsrau, zse3t ! temporary scalars 67 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrtrd68 67 CHARACTER (len=22) :: charout 69 68 !!---------------------------------------------------------------------- 70 69 71 IF( wrk_in_use(2, 1))THEN70 IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1) ) THEN 72 71 CALL ctl_stop('trc_sbc: requested workspace array unavailable.') ; RETURN 73 72 END IF … … 79 78 ENDIF 80 79 81 82 IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) )83 80 84 81 IF( lk_offline ) THEN ! emps in dynamical files contains emps - rnf … … 115 112 END DO ! tracer loop 116 113 ! ! =========== 117 IF( l_trdtrc ) DEALLOCATE( ztrtrd )118 119 114 IF( ln_ctl ) THEN 120 115 WRITE(charout, FMT="('sbc ')") ; CALL prt_ctl_trc_info(charout) … … 122 117 ENDIF 123 118 124 IF( wrk_not_released(2, 1) ) CALL ctl_stop('trc_sbc: failed to release workspace array') 125 ! 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 126 122 END SUBROUTINE trc_sbc 127 123 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r2636 r2643 23 23 USE trdtra 24 24 USE prtctl_trc ! Print control 25 USE in_out_manager ! I/O manager26 USE lbclnk ! ocean lateral boundary conditions (or mpp link)27 USE lib_mpp ! MPP library28 25 29 26 IMPLICIT NONE -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc.F90
r2636 r2643 244 244 !!---------------------------------------------------------------------- 245 245 246 IF(wrk_in_use(2, 1))THEN 247 CALL ctl_stop('trd_mld_bio_zint : requested workspace array unavailable.') 248 RETURN 246 IF( wrk_in_use(2, 1) ) THEN 247 CALL ctl_stop('trd_mld_bio_zint : requested workspace array unavailable.') ; RETURN 249 248 END IF 250 249 … … 329 328 END DO 330 329 331 IF(wrk_not_released(2, 1))THEN 332 CALL ctl_stop('trd_mld_bio_zint : failed to release workspace array.') 333 END IF 330 IF( wrk_not_released(2, 1) ) CALL ctl_stop('trd_mld_bio_zint : failed to release workspace array.') 334 331 #endif 335 332 … … 912 909 IF( lrst_trc ) CALL trd_mld_trc_rst_write( kt ) ! this must be after the array swap above (III.3) 913 910 914 IF(wrk_not_released(3, 1,2,3,4,5,6,7,8,9))THEN 915 CALL ctl_stop('trd_mld_trc : failed to release workspace arrays.') 916 END IF 911 IF( wrk_not_released(3, 1,2,3,4,5,6,7,8,9) ) & 912 & CALL ctl_stop('trd_mld_trc : failed to release workspace arrays.') 917 913 ! 918 914 END SUBROUTINE trd_mld_trc -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc_oce.F90
r2636 r2643 116 116 tmltrd_csum_ub_bio !: before (prev. analysis period) cumulated sum over the 117 117 !: upper triangle 118 # endif 118 #endif 119 119 120 !!---------------------------------------------------------------------- 120 121 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 155 156 tmltrdm_trc(jpi,jpj,jptra), & 156 157 Stat=ierr(1)) 157 # endif 158 #endif 159 158 160 # if defined key_lobster 159 161 ALLOCATE(tmltrd_bio(jpi,jpj,jpdiabio), & -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r2528 r2643 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 36 42 !* physical constants * 37 43 USE phycst … … 88 94 USE dom_oce , ONLY : e1t => e1t !: horizontal scale factors at t-point (m) 89 95 USE dom_oce , ONLY : e2t => e2t !: horizontal scale factors at t-point (m) 96 USE dom_oce , ONLY : e1e2t => e1e2t !: cell surface at t-point (m2) 90 97 USE dom_oce , ONLY : e1u => e1u !: horizontal scale factors at u-point (m) 91 98 USE dom_oce , ONLY : e2u => e2u !: horizontal scale factors at u-point (m) … … 194 201 195 202 #endif 196 USE lib_mpp , ONLY : lk_mpp => lk_mpp !: Mpp flag197 203 198 204 USE dom_oce , ONLY : nn_cla => nn_cla !: flag (0/1) for cross land advection -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90
r2633 r2643 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 … … 78 76 !!---------------------------------------------------------------------- 79 77 80 IF( wrk_in_use(3, 1,2))THEN78 IF( wrk_in_use(3, 1,2) ) THEN 81 79 CALL ctl_stop('prt_ctl_trc : requested workspace arrays unavailable.') 82 80 RETURN … … 158 156 END DO 159 157 ! 160 IF(wrk_not_released(3, 1,2))THEN 161 CALL ctl_stop('prt_ctl_trc : failed to release workspace arrays.') 162 END IF 158 IF( wrk_not_released(3, 1,2) ) CALL ctl_stop('prt_ctl_trc : failed to release workspace arrays.') 163 159 ! 164 160 END SUBROUTINE prt_ctl_trc -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trc.F90
r2636 r2643 119 119 trb(jpi,jpj,jpk,jptra), & 120 120 gtru(jpi,jpj,jptra), gtrv(jpi,jpj,jptra), & 121 rdttrc(jpk), &122 121 # if defined key_diatrc && ! defined key_iomput 123 122 trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d), & … … 125 124 # if defined key_diabio 126 125 trbio(jpi,jpj,jpk,jpdiabio), & 127 # 128 STAT=trc_alloc)126 #endif 127 rdttrc(jpk), STAT=trc_alloc ) 129 128 130 129 IF( trc_alloc /= 0 ) CALL ctl_warn('trc_alloc: failed to allocate arrays') 131 130 ! 132 131 END FUNCTION trc_alloc 133 132 134 133 #else 135 134 !!---------------------------------------------------------------------- -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trcdia.F90
r2593 r2643 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 … … 63 61 CONTAINS 64 62 65 FUNCTION trc_dia_alloc()66 !!---------------------------------------------------------------------67 !! *** ROUTINE trc_dia_alloc ***68 !!---------------------------------------------------------------------69 INTEGER :: trc_dia_alloc70 !!---------------------------------------------------------------------71 72 ALLOCATE(ndext50(jpij*jpk), ndext51(jpij), Stat=trc_dia_alloc)73 74 IF(trc_dia_alloc /= 0)THEN75 CALL ctl_warn('trc_dia_alloc : failed to allocate arrays.')76 END IF77 78 END FUNCTION trc_dia_alloc79 80 63 81 64 SUBROUTINE trc_dia( kt ) … … 200 183 DO jn = 1, jptra 201 184 IF( lutsav(jn) ) THEN 202 cltra = ctrcnm(jn) ! short title for tracer203 cltral = ctrcnl(jn) ! long title for tracer204 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 205 188 CALL histdef( nit5, cltra, cltral, cltrau, jpi, jpj, nhorit5, & 206 189 & ipk, 1, ipk, ndepit5, 32, clop, zsto, zout ) … … 225 208 226 209 DO jn = 1, jptra 227 cltra = ctrcnm(jn)! short title for tracer210 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 228 211 IF( lutsav(jn) ) CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 ) 229 212 END DO … … 325 308 ! more 3D horizontal arrays 326 309 DO jl = 1, jpdia3d 327 cltra = ctrc3d(jl) ! short title for 3D diagnostic328 cltral = ctrc3l(jl)! long title for 3D diagnostic329 cltrau = ctrc3u(jl)! UNIT for 3D diagnostic310 cltra = TRIM( ctrc3d(jl) ) ! short title for 3D diagnostic 311 cltral = TRIM( ctrc3l(jl) ) ! long title for 3D diagnostic 312 cltrau = TRIM( ctrc3u(jl) ) ! UNIT for 3D diagnostic 330 313 CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd, & 331 314 & ipk, 1, ipk, ndepitd, 32, clop, zsto, zout ) … … 334 317 ! more 2D horizontal arrays 335 318 DO jl = 1, jpdia2d 336 cltra = ctrc2d(jl)! short title for 2D diagnostic337 cltral = ctrc2l(jl)! long title for 2D diagnostic338 cltrau = ctrc2u(jl)! UNIT for 2D diagnostic319 cltra = TRIM( ctrc2d(jl) ) ! short title for 2D diagnostic 320 cltral = TRIM( ctrc2l(jl) ) ! long title for 2D diagnostic 321 cltrau = TRIM( ctrc2u(jl) ) ! UNIT for 2D diagnostic 339 322 CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd, & 340 323 & 1, 1, 1, -99, 32, clop, zsto, zout ) … … 362 345 ! more 3D horizontal arrays 363 346 DO jl = 1, jpdia3d 364 cltra = ctrc3d(jl) ! short title for 3D diagnostic347 cltra = TRIM( ctrc3d(jl) ) ! short title for 3D diagnostic 365 348 CALL histwrite( nitd, cltra, it, trc3d(:,:,:,jl), ndimt50 ,ndext50) 366 349 END DO … … 368 351 ! more 2D horizontal arrays 369 352 DO jl = 1, jpdia2d 370 cltra = ctrc2d(jl) ! short title for 2D diagnostic353 cltra = TRIM( ctrc2d(jl) ) ! short title for 2D diagnostic 371 354 CALL histwrite(nitd, cltra, it, trc2d(:,:,jl), ndimt51 ,ndext51) 372 355 END DO … … 468 451 ! biological trends 469 452 DO jl = 1, jpdiabio 470 cltra = ctrbio(jl) ! short title for biological diagnostic471 cltral = ctrbil(jl)! long title for biological diagnostic472 cltrau = ctrbiu(jl)! UNIT for biological diagnostic453 cltra = TRIM( ctrbio(jl) ) ! short title for biological diagnostic 454 cltral = TRIM( ctrbil(jl) ) ! long title for biological diagnostic 455 cltrau = TRIM( ctrbiu(jl) ) ! UNIT for biological diagnostic 473 456 CALL histdef( nitb, cltra, cltral, cltrau, jpi, jpj, nhoritb, & 474 457 & ipk, 1, ipk, ndepitb, 32, clop, zsto, zout) … … 494 477 495 478 DO jl = 1, jpdiabio 496 cltra = ctrbio(jl)! short title for biological diagnostic479 cltra = TRIM( ctrbio(jl) ) ! short title for biological diagnostic 497 480 CALL histwrite(nitb, cltra, it, trbio(:,:,:,jl), ndimt50,ndext50) 498 481 END DO … … 513 496 # endif 514 497 498 INTEGER FUNCTION trc_dia_alloc() 499 !!--------------------------------------------------------------------- 500 !! *** ROUTINE trc_dia_alloc *** 501 !!--------------------------------------------------------------------- 502 503 ALLOCATE( ndext50(jpij*jpk), ndext51(jpij), STAT=trc_dia_alloc ) 504 505 IF( trc_dia_alloc /= 0 ) CALL ctl_warn('trc_dia_alloc : failed to allocate arrays.') 506 507 END FUNCTION trc_dia_alloc 515 508 #else 516 509 !!---------------------------------------------------------------------- -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r2593 r2643 42 42 !!---------------------------------------------------------------------- 43 43 CONTAINS 44 45 FUNCTION trc_dta_alloc()46 !!----------------------------------------------------------------------47 !! *** ROUTINE trc_dta_alloc ***48 !!----------------------------------------------------------------------49 INTEGER :: trc_dta_alloc50 !!----------------------------------------------------------------------51 52 ALLOCATE(trdta(jpi,jpj,jpk,jptra), &53 tracdta(jpi,jpj,jpk,jptra,2), &54 nlectr(jptra), ntrc1(jptra), ntrc2,(jptra), &55 !56 Stat = trc_dta_alloc)57 58 IF(trc_dta_alloc /= 0)THEN59 CALL ctl_warn('trc_dta_alloc : failed to allocate arrays.')60 END IF61 62 END FUNCTION trc_dta_alloc63 64 44 65 45 SUBROUTINE trc_dta( kt ) … … 219 199 END SUBROUTINE trc_dta 220 200 201 INTEGER FUNCTION trc_dta_alloc() 202 !!---------------------------------------------------------------------- 203 !! *** ROUTINE trc_dta_alloc *** 204 !!---------------------------------------------------------------------- 205 206 ALLOCATE(trdta(jpi,jpj,jpk,jptra), & 207 tracdta(jpi,jpj,jpk,jptra,2), & 208 nlectr(jptra), ntrc1(jptra), ntrc2,(jptra), & 209 ! 210 STAT=trc_dta_alloc) 211 212 IF( trc_dta_alloc /= 0 ) CALL ctl_warn('trc_dta_alloc : failed to allocate arrays.') 213 214 END FUNCTION trc_dta_alloc 215 221 216 #else 222 217 !!---------------------------------------------------------------------- -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r2630 r2643 28 28 USE daymod 29 29 USE zpshde ! partial step: hor. derivative (zps_hde routine) 30 USE in_out_manager ! I/O manager31 30 USE prtctl_trc ! Print control passive tracers (prt_ctl_trc_init routine) 32 USE lib_mpp ! distributed memory computing library33 USE lib_fortran !34 31 35 32 IMPLICIT NONE … … 67 64 IF(lwp) WRITE(numout,*) '~~~~~~~' 68 65 66 69 67 CALL top_alloc() ! allocate TOP arrays 70 68 … … 201 199 USE trdmld_trc , ONLY: trd_mld_trc_alloc 202 200 #endif 203 #if defined key_cfc204 USE trcsms_cfc , ONLY: trc_sms_cfc_alloc205 #endif206 #if defined key_c14b207 USE trcsms_c14b , ONLY: trc_sms_c14b_alloc208 #endif209 #if defined key_lobster210 USE sms_lobster , ONLY: sms_lobster_alloc ! LOBSTER-related alloc routines...211 #endif212 201 ! 213 202 INTEGER :: ierr … … 231 220 ierr = ierr + trd_mld_trc_alloc() 232 221 #endif 233 #if defined key_cfc234 ierr = ierr + trc_sms_cfc_alloc()235 #endif236 #if defined key_c14b237 ierr = ierr + trc_sms_c14b_alloc()238 #endif239 !240 #if defined key_lobster241 ierr = ierr + sms_lobster_alloc() ! Start of LOBSTER-related alloc routines242 #endif243 222 ! 244 223 IF( lk_mpp ) CALL mpp_sum( ierr ) -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r2636 r2643 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 USE lib_mpp ! MPP library30 28 USE trdmod_trc_oce 31 29 … … 104 102 105 103 DO jn = 1, jptra 106 ctrcnm(jn) = sn_tracer(jn)%clsname107 ctrcnl(jn) = sn_tracer(jn)%cllname108 ctrcun(jn) = sn_tracer(jn)%clunit109 lutini(jn) = sn_tracer(jn)%llinit110 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 111 109 END DO 112 110 … … 122 120 DO jn = 1, jptra 123 121 WRITE(numout,*) ' tracer nb : ', jn 124 WRITE(numout,*) ' short name : ', TRIM(ctrcnm(jn))125 WRITE(numout,*) ' long name : ', TRIM(ctrcnl(jn))126 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) 127 125 WRITE(numout,*) ' initial value in FILE : ', lutini(jn) 128 126 WRITE(numout,*) ' ' -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r2528 r2643 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 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r2528 r2643 64 64 ELSE ; CALL trc_dia( kt ) 65 65 ENDIF 66 CALL trc_sms( kt ) ! tracers: sink and source66 ! CALL trc_sms( kt ) ! tracers: sink and source 67 67 CALL trc_trp( kt ) ! transport of passive tracers 68 68 IF( kt == nit000 ) CALL iom_close( numrtr ) ! close input passive tracers restart file
Note: See TracChangeset
for help on using the changeset viewer.