Changeset 2613
- Timestamp:
- 2011-02-25T11:45:57+01:00 (13 years ago)
- Location:
- branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO
- Files:
-
- 31 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90
r2590 r2613 4 4 !! Sea Ice physics: diagnostics variables of ice defined in memory 5 5 !!===================================================================== 6 !! History : 2.0 ! 2003-08 (C. Ethe) F90: Free form and module 7 !! 3.3 ! 2009-05 (G.Garric) addition of the lim2_evp cas 6 !! History : 2.0 ! 2003-08 (C. Ethe) F90: Free form and module 7 !! 3.3 ! 2009-05 (G.Garric) addition of the lim2_evp cas 8 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_lim2 … … 16 17 PRIVATE 17 18 18 ! Routine accessibility 19 PUBLIC ice_alloc_2 ! Called in nemogcm.F90 19 PUBLIC ice_alloc_2 ! Called in iceini_2.F90 20 20 21 21 INTEGER , PUBLIC :: numit !: ice iteration index … … 124 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sxc2, syc2, sxxc2, syyc2, sxyc2 !: for heat content of 2nd ice layer 125 125 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sxst, syst, sxxst, syyst, sxyst !: for heat content of brine pockets 126 126 !!---------------------------------------------------------------------- 127 CONTAINS 128 129 FUNCTION ice_alloc_2() 130 !!----------------------------------------------------------------- 131 !! *** FUNCTION ice_alloc_2 *** 132 !!----------------------------------------------------------------- 133 USE in_out_manager, ONLY: ctl_warn 134 INTEGER :: ice_alloc_2 ! return value 135 INTEGER :: ierr(9) ! Local variables 136 !!----------------------------------------------------------------- 137 138 ierr(:) = 0 139 140 ALLOCATE( ahiu(jpi,jpj) , pahu(jpi,jpj) , & 141 & ahiv(jpi,jpj) , pahv(jpi,jpj) , ust2s(jpi,jpj) , STAT=ierr(1) ) 142 143 !* Ice Rheology 144 #if defined key_lim2_vp 145 ALLOCATE( hsnm(jpi,jpj) , hicm(jpi,jpj) , STAT=ierr(2) ) 127 146 #else 147 ALLOCATE( stress1_i (jpi,jpj) , delta_i(jpi,jpj) , at_i(jpi,jpj) , & 148 stress2_i (jpi,jpj) , divu_i (jpi,jpj) , hsnm(jpi,jpj) , & 149 stress12_i(jpi,jpj) , shear_i(jpi,jpj) , hicm(jpi,jpj) , STAT=ierr(2) ) 150 #endif 151 152 ALLOCATE( rdvosif(jpi,jpj) , rdvobif(jpi,jpj) , & 153 & fdvolif(jpi,jpj) , rdvonif(jpi,jpj) , & 154 & sist (jpi,jpj) , tfu (jpi,jpj) , hicif(jpi,jpj) , & 155 & hsnif (jpi,jpj) , hicifp (jpi,jpj) , frld (jpi,jpj) , STAT=ierr(3) ) 156 157 ALLOCATE(phicif(jpi,jpj) , pfrld (jpi,jpj) , qstoif (jpi,jpj) , & 158 & fbif (jpi,jpj) , rdmsnif(jpi,jpj) , rdmicif(jpi,jpj) , & 159 & qldif (jpi,jpj) , qcmif (jpi,jpj) , fdtcn (jpi,jpj) , & 160 & qdtcn (jpi,jpj) , thcm (jpi,jpj) , STAT=ierr(4) ) 161 162 ALLOCATE(fstric(jpi,jpj) , ffltbif(jpi,jpj) , fscmbq(jpi,jpj) , & 163 & fsbbq (jpi,jpj) , qfvbq (jpi,jpj) , dmgwi (jpi,jpj) , & 164 & u_ice (jpi,jpj) , v_ice (jpi,jpj) , & 165 & u_oce (jpi,jpj) , v_oce (jpi,jpj) , & 166 & tbif (jpi,jpj,jplayersp1) , STAT=ierr(5)) 167 168 !* moment used in the advection scheme 169 ALLOCATE(sxice (jpi,jpj) , syice (jpi,jpj) , sxxice(jpi,jpj) , & 170 & syyice(jpi,jpj) , sxyice(jpi,jpj) , & 171 & sxsn (jpi,jpj) , sysn (jpi,jpj) , sxxsn (jpi,jpj) , & 172 & syysn (jpi,jpj) , sxysn (jpi,jpj) , STAT=ierr(6) ) 173 ALLOCATE(sxa (jpi,jpj) , sya (jpi,jpj) , sxxa (jpi,jpj) , & 174 & syya (jpi,jpj) , sxya (jpi,jpj) , & 175 & sxc0 (jpi,jpj) , syc0 (jpi,jpj) , sxxc0 (jpi,jpj) , & 176 & syyc0 (jpi,jpj) , sxyc0 (jpi,jpj) , STAT=ierr(7)) 177 ALLOCATE(sxc1 (jpi,jpj) , syc1 (jpi,jpj) , sxxc1 (jpi,jpj) , & 178 & syyc1 (jpi,jpj) , sxyc1 (jpi,jpj) , & 179 & sxc2 (jpi,jpj) , syc2 (jpi,jpj) , sxxc2 (jpi,jpj) , & 180 & syyc2 (jpi,jpj) , sxyc2 (jpi,jpj) , STAT=ierr(8)) 181 ALLOCATE(sxst (jpi,jpj) , syst (jpi,jpj) , sxxst (jpi,jpj) , & 182 & syyst (jpi,jpj) , sxyst (jpi,jpj) , STAT=ierr(9)) 183 184 ice_alloc_2 = MAXVAL( ierr ) 185 186 IF( ice_alloc_2 /= 0 ) CALL ctl_warn('ice_alloc_2: failed to allocate arrays.') 187 ! 188 END FUNCTION ice_alloc_2 189 190 #else 128 191 !!---------------------------------------------------------------------- 129 192 !! Default option Empty module NO LIM 2.0 sea-ice model 130 193 !!---------------------------------------------------------------------- 131 194 #endif 132 133 !!---------------------------------------------------------------------- 195 !!----------------------------------------------------------------- 134 196 !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 135 197 !! $Id$ 136 198 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 137 199 !!====================================================================== 138 139 #if defined key_lim2140 CONTAINS141 142 FUNCTION ice_alloc_2()143 !!-----------------------------------------------------------------144 !! *** Routine ice_alloc_2 ***145 !!-----------------------------------------------------------------146 USE in_out_manager, ONLY: ctl_warn147 IMPLICIT none148 INTEGER :: ice_alloc_2149 ! Local variables150 INTEGER :: ierr(9)151 !!-----------------------------------------------------------------152 153 ierr(:) = 0154 155 ! What could be one huge allocate statement is broken-up to try to156 ! stay within Fortran's max-line length limit.157 ALLOCATE(ahiu(jpi,jpj), ahiv(jpi,jpj), &158 pahu(jpi,jpj), pahv(jpi,jpj), &159 ust2s(jpi,jpj), Stat=ierr(1))160 161 ALLOCATE( &162 #if defined key_lim2_vp163 hsnm(jpi,jpj), hicm(jpi,jpj), &164 #else165 stress1_i(jpi,jpj), stress2_i(jpi,jpj), stress12_i(jpi,jpj), &166 delta_i(jpi,jpj), divu_i(jpi,jpj), shear_i(jpi,jpj), &167 at_i(jpi,jpj), hsnm(jpi,jpj), hicm(jpi,jpj), &168 #endif169 Stat=ierr(2))170 171 ALLOCATE(rdvosif(jpi,jpj), rdvobif(jpi,jpj), &172 fdvolif(jpi,jpj), rdvonif(jpi,jpj), &173 sist(jpi,jpj), tfu(jpi,jpj), hicif(jpi,jpj), &174 hsnif(jpi,jpj), hicifp(jpi,jpj), frld(jpi,jpj), &175 Stat=ierr(3))176 177 ALLOCATE(phicif(jpi,jpj), pfrld(jpi,jpj), qstoif(jpi,jpj), &178 fbif(jpi,jpj), rdmsnif(jpi,jpj), rdmicif(jpi,jpj), &179 qldif(jpi,jpj), qcmif(jpi,jpj), fdtcn(jpi,jpj), &180 qdtcn(jpi,jpj), thcm(jpi,jpj), Stat=ierr(4))181 182 ALLOCATE(fstric(jpi,jpj), ffltbif(jpi,jpj), fscmbq(jpi,jpj), &183 fsbbq(jpi,jpj), qfvbq(jpi,jpj), dmgwi(jpi,jpj), &184 u_ice(jpi,jpj), v_ice(jpi,jpj), &185 u_oce(jpi,jpj), v_oce(jpi,jpj), &186 tbif(jpi,jpj,jplayersp1), Stat=ierr(5))187 188 ALLOCATE(sxice(jpi,jpj), syice(jpi,jpj), sxxice(jpi,jpj), &189 syyice(jpi,jpj), sxyice(jpi,jpj), &190 sxsn(jpi,jpj), sysn(jpi,jpj), sxxsn(jpi,jpj), &191 syysn(jpi,jpj), sxysn(jpi,jpj), Stat=ierr(6))192 193 ALLOCATE(sxa(jpi,jpj), sya(jpi,jpj), sxxa(jpi,jpj), &194 syya(jpi,jpj), sxya(jpi,jpj), &195 sxc0(jpi,jpj), syc0(jpi,jpj), sxxc0(jpi,jpj), &196 syyc0(jpi,jpj), sxyc0(jpi,jpj), Stat=ierr(7))197 198 ALLOCATE(sxc1(jpi,jpj), syc1(jpi,jpj), sxxc1(jpi,jpj), &199 syyc1(jpi,jpj), sxyc1(jpi,jpj), &200 sxc2(jpi,jpj), syc2(jpi,jpj), sxxc2(jpi,jpj), &201 syyc2(jpi,jpj), sxyc2(jpi,jpj), Stat=ierr(8))202 203 ALLOCATE(sxst(jpi,jpj), syst(jpi,jpj), sxxst(jpi,jpj), &204 syyst(jpi,jpj), sxyst(jpi,jpj), Stat=ierr(9))205 206 ice_alloc_2 = MAXVAL(ierr)207 208 IF(ice_alloc_2 /= 0)THEN209 CALL ctl_warn('ice_alloc_2: failed to allocate arrays.')210 END IF211 212 END FUNCTION ice_alloc_2213 214 #endif215 216 200 END MODULE ice_2 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90
r2528 r2613 4 4 !! Sea-ice model : LIM 2.0 Sea ice model Initialization 5 5 !!====================================================================== 6 !! History : 1.0 ! 02-08 (G. Madec) F90: Free form and modules 7 !! 2.0 ! 03-08 (C. Ethe) add ice_run 8 !! 3.3 ! 09-05 (G.Garric, C. Bricaud) addition of the lim2_evp case 6 !! History : 1.0 ! 2002-08 (G. Madec) F90: Free form and modules 7 !! 2.0 ! 2003-08 (C. Ethe) add ice_run 8 !! 3.3 ! 2009-05 (G. Garric, C. Bricaud) addition of the lim2_evp case 9 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_lim2 … … 12 13 !! 'key_lim2' : LIM 2.0 sea-ice model 13 14 !!---------------------------------------------------------------------- 14 !!----------------------------------------------------------------------15 15 !! ice_init_2 : sea-ice model initialization 16 16 !! ice_run_2 : Definition some run parameter for ice model 17 17 !!---------------------------------------------------------------------- 18 USE phycst ! physical constants 18 19 USE dom_oce ! ocean domain 19 USE dom_ice_2 ! LIM2 :ice domain20 USE dom_ice_2 ! LIM2 ice domain 20 21 USE sbc_oce ! surface boundary condition: ocean 21 22 USE sbc_ice ! surface boundary condition: ice 22 USE phycst ! Define parameters for the routines 23 USE ice_2 ! LIM2: ice variable 24 USE limmsh_2 ! LIM2: mesh 25 USE limistate_2 ! LIM2: initial state 26 USE limrst_2 ! LIM2: restart 23 USE thd_ice_2 ! LIM2 thermodynamical variables 24 USE limrhg ! LIM2 rheology 25 USE ice_2 ! LIM2 ice variable 26 USE limmsh_2 ! LIM2 mesh 27 USE limistate_2 ! LIM2 initial state 28 USE limrst_2 ! LIM2 restart 29 USE limsbc_2 ! LIM2 surface boundary condition 27 30 USE in_out_manager ! I/O manager 28 31 … … 33 36 34 37 !!---------------------------------------------------------------------- 35 !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)38 !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011) 36 39 !! $Id$ 37 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 45 48 !! ** purpose : initialisation of LIM-2 domain and variables 46 49 !!---------------------------------------------------------------------- 50 INTEGER :: ierr 51 !!---------------------------------------------------------------------- 47 52 ! 53 IF(lwp) THEN 54 WRITE(numout,*) 55 WRITE(numout,*) 'ice_init_2 : LIM-2 sea-ice - initialization' 56 WRITE(numout,*) '~~~~~~~~~~~ ' 57 ENDIF 58 ! ! Allocate the ice arrays 59 ierr = ice_alloc_2 () ! ice variables 60 ierr = ierr + dom_ice_alloc_2() ! domain 61 ierr = ierr + sbc_ice_alloc () ! surface forcing 62 ierr = ierr + thd_ice_alloc_2() ! thermodynamics 63 #if ! defined key_lim2_vp 64 ierr = ierr + lim_rhg_alloc () 65 #endif 66 IF( lk_mpp ) CALL mpp_sum( ierr ) 67 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'ice_init_2 : unable to allocate ice arrays' ) 68 48 69 ! ! Open the namelist file 49 70 CALL ctl_opn( numnam_ice, 'namelist_ice', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) … … 61 82 ENDIF 62 83 ! 63 tn_ice(:,:,1) = sist(:,:) ! initialisation of ice temperature 64 fr_i (:,:) = 1.0 - frld(:,:) ! initialisation of sea-ice fraction 84 tn_ice(:,:,1) = sist(:,:) ! ice temperature known by the ocean 85 fr_i (:,:) = 1.0 - frld(:,:) ! sea-ice fraction known by the ocean 86 ! 87 CALL lim_sbc_init_2 ! ice surface boundary condition 88 ! 89 IF( lk_lim2_vp ) THEN ; WRITE(numout,*) ' VP rheology - B-grid case' 90 ELSE ; WRITE(numout,*) ' EVP rheology - C-grid case' 91 ENDIF 65 92 ! 66 93 END SUBROUTINE ice_init_2 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90
r2590 r2613 58 58 !! Reference: Prather, 1986, JGR, 91, D6. 6671-6681. 59 59 !!-------------------------------------------------------------------- 60 USE wrk_nemo, ONLY: wrk_use, wrk_release 61 USE wrk_nemo, ONLY: zf0 => wrk_2d_11, zfx => wrk_2d_12, zfy => wrk_2d_13 62 USE wrk_nemo, ONLY: zbet => wrk_2d_14, zfm => wrk_2d_15, zfxx => wrk_2d_16 63 USE wrk_nemo, ONLY: zfyy => wrk_2d_17, zfxy => wrk_2d_18, zalg => wrk_2d_19 64 USE wrk_nemo, ONLY: zalg1 => wrk_2d_20, zalg1q => wrk_2d_21 65 !! 60 USE wrk_nemo, ONLY: wrk_use, wrk_release 61 USE wrk_nemo, ONLY: zf0 => wrk_2d_11 , zfx => wrk_2d_12 , zfy => wrk_2d_13 , zbet => wrk_2d_14 ! 2D workspace 62 USE wrk_nemo, ONLY: zfm => wrk_2d_15 , zfxx => wrk_2d_16 , zfyy => wrk_2d_17 , zfxy => wrk_2d_18 ! - - 63 USE wrk_nemo, ONLY: zalg => wrk_2d_19 , zalg1 => wrk_2d_20 , zalg1q => wrk_2d_21 ! - - 64 ! 66 65 REAL(wp) , INTENT(in ) :: pdf ! reduction factor for the time step 67 66 REAL(wp) , INTENT(in ) :: pcrh ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0) … … 71 70 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: psx , psy ! 1st moments 72 71 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: psxx, psyy, psxy ! 2nd moments 73 ! !72 ! 74 73 INTEGER :: ji, jj ! dummy loop indices 75 74 REAL(wp) :: zs1max, zrdt, zslpmax, ztemp, zin0 ! temporary scalars … … 78 77 !--------------------------------------------------------------------- 79 78 80 IF(.NOT. wrk_use(2, 11,12,13,14,15,16,17,18,19,20,21))THEN 81 CALL ctl_stop('lim_adv_x_2 : requested workspace arrays unavailable.') 82 RETURN 79 IF( .NOT. wrk_use(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 80 CALL ctl_stop( 'lim_adv_x_2 : requested workspace arrays unavailable.' ) ; RETURN 83 81 END IF 84 82 … … 226 224 ENDIF 227 225 ! 228 IF( .NOT. wrk_release(2, 11,12,13,14,15,16,17,18,19,20,21))THEN229 CALL ctl_stop( 'lim_adv_x_2 : failed to release workspace arrays.')226 IF( .NOT. wrk_release(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 227 CALL ctl_stop( 'lim_adv_x_2 : failed to release workspace arrays.' ) 230 228 END IF 231 229 ! … … 247 245 !! Reference: Prather, 1986, JGR, 91, D6. 6671-6681. 248 246 !!--------------------------------------------------------------------- 249 USE wrk_nemo, ONLY: wrk_use, wrk_release 250 USE wrk_nemo, ONLY: zf0 => wrk_2d_11, zfx => wrk_2d_12, zfy => wrk_2d_13 251 USE wrk_nemo, ONLY: zbet => wrk_2d_14, zfm => wrk_2d_15, zfxx => wrk_2d_16 252 USE wrk_nemo, ONLY: zfyy => wrk_2d_17, zfxy => wrk_2d_18, zalg => wrk_2d_19 253 USE wrk_nemo, ONLY: zalg1 => wrk_2d_20, zalg1q => wrk_2d_21 247 USE wrk_nemo, ONLY: wrk_use, wrk_release 248 USE wrk_nemo, ONLY: zf0 => wrk_2d_11 , zfx => wrk_2d_12 , zfy => wrk_2d_13 , zbet => wrk_2d_14 ! 2D workspace 249 USE wrk_nemo, ONLY: zfm => wrk_2d_15 , zfxx => wrk_2d_16 , zfyy => wrk_2d_17 , zfxy => wrk_2d_18 ! - - 250 USE wrk_nemo, ONLY: zalg => wrk_2d_19 , zalg1 => wrk_2d_20 , zalg1q => wrk_2d_21 ! - - 254 251 !! 255 252 REAL(wp) , INTENT(in ) :: pdf ! reduction factor for the time step … … 267 264 !--------------------------------------------------------------------- 268 265 269 IF(.NOT. wrk_use(2, 11,12,13,14,15,16,17,18,19,20,21))THEN 270 CALL ctl_stop('lim_adv_y_2 : requested workspace arrays unavailable.') 271 RETURN 266 IF(.NOT. wrk_use(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 267 CALL ctl_stop( 'lim_adv_y_2 : requested workspace arrays unavailable.' ) ; RETURN 272 268 END IF 273 269 … … 418 414 ENDIF 419 415 ! 420 IF( .NOT. wrk_release(2, 11,12,13,14,15,16,17,18,19,20,21))THEN421 CALL ctl_stop( 'lim_adv_y_2 : failed to release workspace arrays.')416 IF( .NOT. wrk_release(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 417 CALL ctl_stop( 'lim_adv_y_2 : failed to release workspace arrays.' ) 422 418 END IF 423 419 ! -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90
r2590 r2613 29 29 30 30 PUBLIC lim_dia_2 ! called by sbc_ice_lim_2 31 PUBLIC lim_dia_alloc_2 ! called by nemogcm32 31 33 32 INTEGER, PUBLIC :: ntmoy = 1 , & !: instantaneous values of ice evolution or averaging ntmoy … … 63 62 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 64 63 !!---------------------------------------------------------------------- 65 66 64 CONTAINS 67 68 FUNCTION lim_dia_alloc_2()69 !!--------------------------------------------------------------------70 !! *** ROUTINE lim_dia_2 ***71 !!--------------------------------------------------------------------72 IMPLICIT none73 INTEGER :: lim_dia_alloc_274 !!--------------------------------------------------------------------75 76 ALLOCATE(aire(jpi,jpj), Stat=lim_dia_alloc_2)77 78 IF(lim_dia_alloc_2 /= 0)THEN79 CALL ctl_warn('lim_dia_alloc_2: failed to allocate array aire.')80 END IF81 82 END FUNCTION lim_dia_alloc_283 84 65 85 66 SUBROUTINE lim_dia_2( kt ) … … 192 173 !!------------------------------------------------------------------- 193 174 CHARACTER(len=jpchinf) :: titinf 194 INTEGER :: jv ! dummy loop indice 195 INTEGER :: ntot , ndeb 196 INTEGER :: nv ! indice of variable 197 REAL(wp) :: zxx0, zxx1 ! temporary scalars 175 INTEGER :: jv ! dummy loop indice 176 INTEGER :: ntot , ndeb, nv, ierr ! local integer 177 REAL(wp) :: zxx0, zxx1 ! local scalars 198 178 199 179 NAMELIST/namicedia/fmtinf, nfrinf, ninfo, ntmoy 200 180 !!------------------------------------------------------------------- 201 181 202 ! Read Namelist namicedia 203 REWIND ( numnam_ice ) 204 READ ( numnam_ice , namicedia ) 182 REWIND( numnam_ice ) ! Read Namelist namicedia 183 READ ( numnam_ice , namicedia ) 205 184 206 IF(lwp) THEN 185 IF(lwp) THEN ! control print 207 186 WRITE(numout,*) 208 187 WRITE(numout,*) 'lim_dia_init_2 : ice parameters for ice diagnostics ' … … 214 193 ENDIF 215 194 216 ! masked grid cell area 195 ALLOCATE( aire(jpi,jpj) , STAT=ierr ) ! masked grid cell area 196 IF( lk_mpp ) CALL mpp_sum( ierr ) 197 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'lim_dia_init_2 : unable to allocate standard arrays' ) 217 198 aire(:,:) = area(:,:) * tms(:,:) 218 199 219 ! Titles of ice key variables : 220 nv = 1 200 nv = 1 ! Titles of ice key variables 221 201 titvar(nv) = 'NoIt' ! iteration number 222 202 nv = nv + 1 223 203 titvar(nv) = 'T yr' ! time step in years 224 225 204 nbvt = nv - 1 226 227 205 nv = nv + 1 ; titvar(nv) = 'AEFN' ! sea ice area in the northern Hemisp.(10^12 km2) 228 206 nv = nv + 1 ; titvar(nv) = 'AEFS' ! sea ice area in the southern Hemisp.(10^12 km2) -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90
r2590 r2613 58 58 !! - treatment of the case if no ice dynamic 59 59 !!--------------------------------------------------------------------- 60 USE wrk_nemo, ONLY: wrk_use, wrk_release 61 USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_2 62 USE wrk_nemo, ONLY: zu_io => wrk_2d_1, zv_io => wrk_2d_2 ! ice-ocean velocity 60 USE wrk_nemo, ONLY: wrk_use, wrk_release 61 USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_2 62 USE wrk_nemo, ONLY: zu_io => wrk_2d_1, zv_io => wrk_2d_2 ! ice-ocean velocity 63 ! 63 64 INTEGER, INTENT(in) :: kt ! number of iteration 64 65 !! … … 66 67 INTEGER :: i_j1, i_jpj ! Starting/ending j-indices for rheology 67 68 REAL(wp) :: zcoef ! temporary scalar 68 REAL(wp), POINTER, DIMENSION(:) 69 REAL(wp), POINTER, DIMENSION(:) 69 REAL(wp), POINTER, DIMENSION(:) :: zind ! i-averaged indicator of sea-ice 70 REAL(wp), POINTER, DIMENSION(:) :: zmsk ! i-averaged of tmask 70 71 !!--------------------------------------------------------------------- 71 72 72 IF( (.NOT. wrk_use(1, 1,2)) .OR. (.NOT. wrk_use(2, 1,2)) )THEN 73 CALL ctl_stop('lim_dyn_2 : requested workspace arrays unavailable.') 74 RETURN 73 IF( .NOT. wrk_use(1, 1,2) .OR. .NOT. wrk_use(2, 1,2) ) THEN 74 CALL ctl_stop( 'lim_dyn_2 : requested workspace arrays unavailable.' ) ; RETURN 75 75 END IF 76 ! Set-up pointers to sub-arrays of workspaces 77 zind => wrk_1d_1(1:jpj) 76 zind => wrk_1d_1(1:jpj) ! Set-up pointers to sub-arrays of workspaces 78 77 zmsk => wrk_1d_2(1:jpj) 79 78 … … 103 102 ! 104 103 DO jj = 1, jpj 105 zind(jj) = SUM( frld (:,jj ) ) ! = FLOAT(jpj) if ocean everywhere on a j-line106 zmsk(jj) = SUM( tmask(:,jj,1) ) ! = 0 104 zind(jj) = SUM( frld (:,jj ) ) ! = REAL(jpj) if ocean everywhere on a j-line 105 zmsk(jj) = SUM( tmask(:,jj,1) ) ! = 0 if land everywhere on a j-line 107 106 END DO 108 107 ! -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90
r2600 r2613 25 25 26 26 PUBLIC lim_hdf_2 ! called by limtrp_2.F90 27 PUBLIC lim_hdf_alloc_2 ! called by nemogcm.F9028 27 29 28 LOGICAL :: linit = .TRUE. ! ! initialization flag (set to flase after the 1st call) 30 29 REAL(wp) :: epsi04 = 1e-04 ! constant 31 30 32 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: efact ! ???31 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: efact ! metric coefficient 33 32 34 33 !! * Substitution … … 40 39 !!---------------------------------------------------------------------- 41 40 CONTAINS 42 43 FUNCTION lim_hdf_alloc_2()44 !!-------------------------------------------------------------------45 !! *** ROUTINE lim_hdf_alloc_2 ***46 !!-------------------------------------------------------------------47 INTEGER :: lim_hdf_alloc_248 !!-------------------------------------------------------------------49 !50 ALLOCATE( efact(jpi,jpj) , STAT=lim_hdf_alloc_2 )51 !52 IF( lim_hdf_alloc_2 /= 0 ) THEN53 CALL ctl_warn( 'lim_hdf_alloc_2: failed to allocate efact array.' )54 ENDIF55 !56 END FUNCTION lim_hdf_alloc_257 58 41 59 42 SUBROUTINE lim_hdf_2( ptab ) … … 74 57 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: ptab ! Field on which the diffusion is applied 75 58 ! 76 INTEGER :: ji, jj! dummy loop indices77 INTEGER :: its, iter ! local integers59 INTEGER :: ji, jj ! dummy loop indices 60 INTEGER :: its, iter, ierr ! local integers 78 61 REAL(wp) :: zalfa, zrlxint, zconv, zeps ! local scalars 79 62 CHARACTER (len=55) :: charout … … 87 70 ! 88 71 IF( linit ) THEN ! Metric coefficient (compute at the first call and saved in efact) 72 ALLOCATE( efact(jpi,jpj) , STAT=ierr ) 73 IF( lk_mpp ) CALL mpp_sum( ierr ) 74 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'lim_hdf_2 : unable to allocate standard arrays' ) 89 75 DO jj = 2, jpjm1 90 76 DO ji = fs_2 , fs_jpim1 ! vector opt. 91 efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj ) + e1v(ji,jj) + e1v(ji,jj-1) ) & 92 & / ( e1t(ji,jj) * e2t(ji,jj) ) 77 efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) / ( e1t(ji,jj) * e2t(ji,jj) ) 93 78 END DO 94 79 END DO -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r2590 r2613 9 9 !! 3.3 ! 2009-05 (G. Garric, C. Bricaud) addition of the lim2_evp case 10 10 !! - ! 2010-11 (G. Madec) ice-ocean stress computed at each ocean time-step 11 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 11 12 !!---------------------------------------------------------------------- 12 13 #if defined key_lim2 … … 14 15 !! 'key_lim2' LIM 2.0 sea-ice model 15 16 !!---------------------------------------------------------------------- 16 !! lim_sbc_flx_2 : update mass, heat and salt fluxes at the ocean surface 17 !! lim_sbc_tau_2 : update i- and j-stresses, and its modulus at the ocean surface 17 !! lim_sbc_alloc_2 : allocate the limsbc arrays 18 !! lim_sbc_init : initialisation 19 !! lim_sbc_flx_2 : update mass, heat and salt fluxes at the ocean surface 20 !! lim_sbc_tau_2 : update i- and j-stresses, and its modulus at the ocean surface 18 21 !!---------------------------------------------------------------------- 19 22 USE par_oce ! ocean parameters … … 36 39 PRIVATE 37 40 38 PUBLIC lim_sbc_ flx_2 ! called by sbc_ice_lim_239 PUBLIC lim_sbc_ tau_2! called by sbc_ice_lim_240 PUBLIC lim_sbc_ alloc_2 ! called by nemogcm.F9041 PUBLIC lim_sbc_init_2 ! called by ice_init_2 42 PUBLIC lim_sbc_flx_2 ! called by sbc_ice_lim_2 43 PUBLIC lim_sbc_tau_2 ! called by sbc_ice_lim_2 41 44 42 45 REAL(wp) :: r1_rdtice ! = 1. / rdt_ice … … 53 56 # include "vectopt_loop_substitute.h90" 54 57 !!---------------------------------------------------------------------- 55 !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)58 !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011) 56 59 !! $Id$ 57 60 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 63 66 !! *** ROUTINE lim_sbc_alloc_2 *** 64 67 !!------------------------------------------------------------------- 65 IMPLICIT none66 68 INTEGER :: lim_sbc_alloc_2 67 69 !!------------------------------------------------------------------- 68 69 ALLOCATE(soce_0(jpi,jpj), sice_0(jpi,jpj), & 70 utau_oce(jpi,jpj), vtau_oce(jpi,jpj), & 71 tmod_io(jpi,jpj), & 72 Stat=lim_sbc_alloc_2) 73 74 IF(lim_sbc_alloc_2 /= 0)THEN 75 CALL ctl_warn('lim_sbc_alloc_2: failed to allocate arrays.') 76 END IF 77 70 ! 71 ALLOCATE( soce_0(jpi,jpj) , utau_oce(jpi,jpj) , & 72 & sice_0(jpi,jpj) , vtau_oce(jpi,jpj) , tmod_io(jpi,jpj), STAT=lim_sbc_alloc_2) 73 ! 74 IF( lk_mpp ) CALL mpp_sum( lim_sbc_alloc_2 ) 75 IF( lim_sbc_alloc_2 /= 0 ) CALL ctl_warn('lim_sbc_alloc_2: failed to allocate arrays.') 76 ! 78 77 END FUNCTION lim_sbc_alloc_2 79 78 … … 121 120 RETURN 122 121 END IF 123 ! Set-up pointers to sub-arrays of 3d workspaces 124 zalb => wrk_3d_4(:,:,1:1) 122 zalb => wrk_3d_4(:,:,1:1) ! Set-up pointers to sub-arrays of 3d workspaces 125 123 zalbp => wrk_3d_5(:,:,1:1) 126 127 IF( kt == nit000 ) THEN128 IF(lwp) WRITE(numout,*)129 IF(lwp) WRITE(numout,*) 'lim_sbc_flx_2 : LIM-2 sea-ice - surface boundary condition - Mass, heat & salt fluxes'130 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ '131 !132 r1_rdtice = 1._wp / rdt_ice133 !134 soce_0(:,:) = soce ! constant SSS and ice salinity used in levitating sea-ice case135 sice_0(:,:) = sice136 !137 IF( cp_cfg == "orca" ) THEN ! decrease ocean & ice reference salinities in the Baltic sea138 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. &139 & 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )140 soce_0(:,:) = 4._wp141 sice_0(:,:) = 2._wp142 END WHERE143 ENDIF144 !145 ENDIF146 124 147 125 !------------------------------------------! … … 260 238 261 239 IF( lk_cpl ) THEN ! coupled case 262 ! Ice surface temperature263 240 tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature 264 ! Computation of snow/ice and ocean albedo241 ! ! Computation of snow/ice and ocean albedo 265 242 CALL albedo_ice( tn_ice, reshape( hicif, (/jpi,jpj,1/) ), reshape( hsnif, (/jpi,jpj,1/) ), zalbp, zalb ) 266 243 alb_ice(:,:,1) = 0.5 * ( zalbp(:,:,1) + zalb (:,:,1) ) ! Ice albedo (mean clear and overcast skys) … … 321 298 ! 322 299 IF(.NOT. wrk_use(2, 1,2))THEN 323 CALL ctl_stop('lim_sbc_tau_2 : requested workspace arrays unavailable.') 324 RETURN 300 CALL ctl_stop('lim_sbc_tau_2 : requested workspace arrays unavailable.') ; RETURN 325 301 END IF 326 !327 IF( kt == nit000 .AND. lwp ) THEN ! control print328 WRITE(numout,*)329 WRITE(numout,*) 'lim_sbc_tau_2 : LIM 2.0 sea-ice - surface ocean momentum fluxes'330 WRITE(numout,*) '~~~~~~~~~~~~~ '331 IF( lk_lim2_vp ) THEN ; WRITE(numout,*) ' VP rheology - B-grid case'332 ELSE ; WRITE(numout,*) ' EVP rheology - C-grid case'333 ENDIF334 ENDIF335 302 ! 336 303 SELECT CASE( cp_ice_msh ) … … 446 413 & tab2d_2=vtau, clinfo2=' vtau : ' , mask2=vmask ) 447 414 ! 448 IF(.NOT. wrk_release(2, 1,2))THEN 449 CALL ctl_stop('lim_sbc_tau_2 : failed to release workspace arrays.') 450 END IF 451 415 IF(.NOT. wrk_release(2, 1,2) ) CALL ctl_stop('lim_sbc_tau_2 : failed to release workspace arrays.') 416 ! 452 417 END SUBROUTINE lim_sbc_tau_2 418 419 420 SUBROUTINE lim_sbc_init_2 421 !!------------------------------------------------------------------- 422 !! *** ROUTINE lim_sbc_init *** 423 !! 424 !! ** Purpose : Preparation of the file ice_evolu for the output of 425 !! the temporal evolution of key variables 426 !! 427 !! ** input : Namelist namicedia 428 !!------------------------------------------------------------------- 429 ! 430 IF(lwp) WRITE(numout,*) 431 IF(lwp) WRITE(numout,*) 'lim_sbc_init_2 : LIM-2 sea-ice - surface boundary condition' 432 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~ ' 433 434 ! ! allocate lim_sbc arrays 435 IF( lim_sbc_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'lim_sbc_flx_2 : unable to allocate arrays' ) 436 ! 437 r1_rdtice = 1._wp / rdt_ice 438 ! 439 soce_0(:,:) = soce ! constant SSS and ice salinity used in levitating sea-ice case 440 sice_0(:,:) = sice 441 ! 442 IF( cp_cfg == "orca" ) THEN ! decrease ocean & ice reference salinities in the Baltic sea 443 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. & 444 & 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 445 soce_0(:,:) = 4._wp 446 sice_0(:,:) = 2._wp 447 END WHERE 448 ENDIF 449 ! 450 END SUBROUTINE lim_sbc_init_2 453 451 454 452 #else -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limtab_2.F90
r2528 r2613 2 2 !!====================================================================== 3 3 !! *** MODULE limtab_2 *** 4 !! 4 !! LIM : transform 1D (2D) array to a 2D (1D) table 5 5 !!====================================================================== 6 6 #if defined key_lim2 7 7 !!---------------------------------------------------------------------- 8 !! tab_2d_1d : 2-D to1-D9 !! tab_1d_2d : 1-D to2-D8 !! tab_2d_1d : 2-D <==> 1-D 9 !! tab_1d_2d : 1-D <==> 2-D 10 10 !!---------------------------------------------------------------------- 11 !! * Modules used12 11 USE par_kind 13 12 … … 15 14 PRIVATE 16 15 17 !! * Routine accessibility 18 PUBLIC tab_2d_1d_2 ! called by lim_ther 19 PUBLIC tab_1d_2d_2 ! called by lim_ther 16 PUBLIC tab_2d_1d_2 ! called by limthd 17 PUBLIC tab_1d_2d_2 ! called by limthd 20 18 21 19 !!---------------------------------------------------------------------- 22 !! NEMO/LIM2 3.3, UCL - NEMO Consortium (2010)20 !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2010) 23 21 !! $Id$ 24 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)22 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 25 23 !!---------------------------------------------------------------------- 26 24 CONTAINS 27 25 28 26 SUBROUTINE tab_2d_1d_2 ( ndim1d, tab1d, tab2d, ndim2d_x, ndim2d_y, tab_ind ) 29 30 INTEGER, INTENT(in) :: & 31 ndim1d, ndim2d_x, ndim2d_y 32 33 REAL(wp), DIMENSION (ndim2d_x, ndim2d_y), INTENT(in) :: & 34 tab2d 35 36 INTEGER, DIMENSION ( ndim1d), INTENT ( in) :: & 37 tab_ind 38 39 REAL(wp), DIMENSION(ndim1d), INTENT ( out) :: & 40 tab1d 41 42 INTEGER :: & 43 jn , jid, jjd 44 27 !!---------------------------------------------------------------------- 28 !! *** ROUTINE tab_2d_1d *** 29 !!---------------------------------------------------------------------- 30 INTEGER , INTENT(in ) :: ndim1d, ndim2d_x, ndim2d_y ! 1D & 2D sizes 31 REAL(wp), DIMENSION(ndim2d_x,ndim2d_y), INTENT(in ) :: tab2d ! input 2D field 32 INTEGER , DIMENSION(ndim1d) , INTENT(in ) :: tab_ind ! input index 33 REAL(wp), DIMENSION(ndim1d) , INTENT( out) :: tab1d ! output 1D field 34 ! 35 INTEGER :: jn , jid, jjd 36 !!---------------------------------------------------------------------- 45 37 DO jn = 1, ndim1d 46 jid = MOD( tab_ind(jn) - 1 , ndim2d_x ) + 147 jjd = ( tab_ind(jn) - 1 ) / ndim2d_x + 138 jid = MOD( tab_ind(jn) - 1 , ndim2d_x ) + 1 39 jjd = ( tab_ind(jn) - 1 ) / ndim2d_x + 1 48 40 tab1d( jn) = tab2d( jid, jjd) 49 41 END DO 50 51 42 END SUBROUTINE tab_2d_1d_2 52 43 53 44 54 45 SUBROUTINE tab_1d_2d_2 ( ndim1d, tab2d, tab_ind, tab1d, ndim2d_x, ndim2d_y ) 55 56 INTEGER, INTENT ( in) :: & 57 ndim1d, ndim2d_x, ndim2d_y 58 59 INTEGER, DIMENSION (ndim1d) , INTENT (in) :: & 60 tab_ind 61 62 REAL(wp), DIMENSION(ndim1d), INTENT (in) :: & 63 tab1d 64 65 REAL(wp), DIMENSION (ndim2d_x, ndim2d_y), INTENT ( out) :: & 66 tab2d 67 68 INTEGER :: & 69 jn, jid, jjd 70 46 !!---------------------------------------------------------------------- 47 !! *** ROUTINE tab_2d_1d *** 48 !!---------------------------------------------------------------------- 49 INTEGER , INTENT(in ) :: ndim1d, ndim2d_x, ndim2d_y ! 1d & 2D sizes 50 REAL(wp), DIMENSION(ndim1d) , INTENT(in ) :: tab1d ! input 1D field 51 INTEGER , DIMENSION(ndim1d) , INTENT(in ) :: tab_ind ! input index 52 REAL(wp), DIMENSION(ndim2d_x,ndim2d_y), INTENT( out) :: tab2d ! output 2D field 53 ! 54 INTEGER :: jn , jid, jjd 55 !!---------------------------------------------------------------------- 71 56 DO jn = 1, ndim1d 72 jid = MOD( tab_ind(jn) - 1 , ndim2d_x) + 157 jid = MOD( tab_ind(jn) - 1 , ndim2d_x ) + 1 73 58 jjd = ( tab_ind(jn) - 1 ) / ndim2d_x + 1 74 59 tab2d(jid, jjd) = tab1d( jn) 75 60 END DO 76 77 61 END SUBROUTINE tab_1d_2d_2 78 62 63 #else 64 !!---------------------------------------------------------------------- 65 !! Default option Dummy module NO LIM sea-ice model 66 !!---------------------------------------------------------------------- 79 67 #endif 68 !!====================================================================== 80 69 END MODULE limtab_2 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90
r2590 r2613 53 53 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex51 ! ???? 54 54 55 REAL(wp) :: & ! constant values 56 epsi16 = 1.e-16 , & 57 zzero = 0.e0 , & 58 zone = 1.e0 55 REAL(wp) :: epsi16 = 1.e-16_wp ! constant values 56 REAL(wp) :: zzero = 0._wp ! - - 57 REAL(wp) :: zone = 1._wp ! - - 59 58 60 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcmo ! Workspace array for netcdf writer. … … 68 67 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 69 68 !!---------------------------------------------------------------------- 70 71 69 CONTAINS 72 70 … … 78 76 INTEGER :: lim_wri_alloc_2 79 77 !!------------------------------------------------------------------- 80 81 ALLOCATE(ndex51(jpij), zcmo(jpi,jpj,jpnoumax), Stat=lim_wri_alloc_2) 82 83 IF(lim_wri_alloc_2 /= 0)THEN 84 CALL ctl_warn('lim_wri_alloc_2: failed to allocate array ndex51') 85 END IF 86 78 ! 79 ALLOCATE( ndex51(jpij), zcmo(jpi,jpj,jpnoumax), STAT=lim_wri_alloc_2) 80 ! 81 IF( lk_mpp ) CALL mpp_sum( ierr ) 82 IF( lim_wri_alloc_2 /= 0 ) CALL ctl_warn('lim_wri_alloc_2: failed to allocate array ndex51') 83 ! 87 84 END FUNCTION lim_wri_alloc_2 88 85 … … 125 122 IF( kt == nit000 ) THEN ! Initialisation ! 126 123 ! !--------------------! 124 127 125 CALL lim_wri_init_2 128 126 … … 253 251 field_19 254 252 !!------------------------------------------------------------------- 253 ! 254 IF( lim_wri_alloc_2() /= 0 ) THEN ! allocate lim_wri arrrays 255 CALL ctl_stop( 'STOP', 'lim_wri_init_2 : unable to allocate standard arrays' ) ; RETURN 256 ENDIF 255 257 256 258 REWIND ( numnam_ice ) ! Read Namelist namicewri -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90
r2590 r2613 18 18 INTEGER, INTENT(in) :: kt ! number of iteration 19 19 20 REAL(wp),DIMENSION(1) :: zdept 20 INTEGER , SAVE :: nmoyice !: counter for averaging 21 INTEGER , SAVE :: nwf !: number of fields to write on disk 22 INTEGER , SAVE, DIMENSION(:), ALLOCATABLE :: nsubindex !: subindex to be saved 23 INTEGER , SAVE :: nice, nhorid, ndim, niter, ndepid 24 REAL(wp), SAVE, DIMENSION(jpi,jpj,jpnoumax) :: rcmoy 21 25 22 REAL(wp) :: & 23 zsto, zsec, zjulian,zout, & 24 zindh,zinda,zindb, & 25 ztmu 26 REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: & 27 zcmo !ARPDBGWORK 28 REAL(wp), DIMENSION(jpi,jpj) :: & 29 zfield 30 INTEGER, SAVE :: nmoyice, & !: counter for averaging 31 & nwf !: number of fields to write on disk 32 INTEGER, SAVE,DIMENSION (:), ALLOCATABLE :: nsubindex !: subindex to be saved 33 ! according to namelist 26 INTEGER :: ji, jj, jf, ii ! dummy loop indices and array index 27 INTEGER :: iyear, iday, imon ! 28 CHARACTER(LEN=80) :: clname, cltext, clmode 29 REAL(wp), DIMENSION(1) :: zdept 30 REAL(wp) :: zsto, zsec, zjulian,zout 31 REAL(wp) :: zindh,zinda,zindb, ztmu 32 REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: zcmo !ARPDBGWORK 33 REAL(wp), DIMENSION(jpi,jpj) :: zfield 34 34 35 REAL(wp), SAVE, DIMENSION(jpi,jpj,jpnoumax) :: rcmoy36 35 #if ! defined key_diainstant 37 36 LOGICAL, PARAMETER :: ll_dia_inst=.false. ! local logical variable … … 39 38 LOGICAL, PARAMETER :: ll_dia_inst=.true. 40 39 #endif 41 INTEGER :: ji, jj, jf, ii ! dummy loop indices and array index 42 INTEGER :: iyear, iday, imon ! 40 !!------------------------------------------------------------------- 43 41 44 CHARACTER(LEN=80) :: clname, cltext, clmode 45 46 47 INTEGER , SAVE :: & 48 nice, nhorid, ndim, niter, ndepid 49 INTEGER , DIMENSION( jpij ) , SAVE :: & 50 ndex51 51 !!------------------------------------------------------------------- 52 IF ( kt == nit000 ) THEN 53 42 IF( kt == nit000 ) THEN 43 ! 54 44 CALL lim_wri_init_2 55 45 … … 57 47 ii = 0 58 48 59 IF 49 IF(lwp ) THEN 60 50 WRITE(numout,*) 'lim_wri_2 : Write ice outputs in dimg' 61 51 WRITE(numout,*) '~~~~~~~~' -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
r2590 r2613 32 32 LOGICAL :: ln_vol = .false. !: =T volume correction 33 33 LOGICAL :: ln_mask = .false. !: =T read bdymask from file 34 LOGICAL :: ln_clim = .false. !: if true, we assume that bdy data files contain 35 ! ! 1 time dump (-->bdy forcing will be constant) 36 ! ! or 12 months (-->bdy forcing will be cyclic) 34 LOGICAL :: ln_clim = .false. !: =T bdy data files contain 1 time dump (-->bdy forcing will be constant) 35 ! ! or 12 months (-->bdy forcing will be cyclic) 37 36 LOGICAL :: ln_dyn_fla = .false. !: =T Flather boundary conditions on barotropic velocities 38 37 LOGICAL :: ln_dyn_frs = .false. !: =T FRS boundary conditions on velocities … … 40 39 LOGICAL :: ln_ice_frs = .false. !: =T FRS boundary conditions on seaice (leads fraction, ice depth, snow depth) 41 40 ! 42 INTEGER :: nn_rimwidth = 7 43 INTEGER :: nn_dtactl = 1 !: = 0 use the initial state as bdy dta or= 1 read it in a NetCDF file44 INTEGER :: nn_volctl = 1 45 ! 41 INTEGER :: nn_rimwidth = 7 !: boundary rim width 42 INTEGER :: nn_dtactl = 1 !: = 0 use the initial state as bdy dta ; = 1 read it in a NetCDF file 43 INTEGER :: nn_volctl = 1 !: = 0 the total volume will have the variability of the surface Flux E-P 44 ! ! = 1 the volume will be constant during all the integration. 46 45 47 46 !!---------------------------------------------------------------------- … … 63 62 INTEGER, DIMENSION(jpbdim,jpbgrd) :: nbmap !: Indices of data in file for data in memory 64 63 65 REAL(wp) :: bdysurftot !: Lateral surface of unstructured open boundary64 REAL(wp) :: bdysurftot !: Lateral surface of unstructured open boundary 66 65 67 66 REAL(wp), DIMENSION(jpbdim) :: flagu, flagv !: Flag for normal velocity compnt for velocity components … … 75 74 REAL(wp), DIMENSION(jpbdim) :: utide, vtide !: Tidal boundary array : U and V 76 75 #if defined key_lim2 77 REAL(wp), DIMENSION(jpbdim) :: &78 frld_bdy, hicif_bdy, & !: Now clim of ice leads fraction, ice79 hsnif_bdy !: thickness andsnow thickness76 REAL(wp), DIMENSION(jpbdim) :: frld_bdy !: now ice leads fraction climatology 77 REAL(wp), DIMENSION(jpbdim) :: hicif_bdy !: Now ice thickness climatology 78 REAL(wp), DIMENSION(jpbdim) :: hsnif_bdy !: now snow thickness 80 79 #endif 80 81 !!---------------------------------------------------------------------- 82 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 83 !! $Id$ 84 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 85 !!---------------------------------------------------------------------- 86 CONTAINS 87 88 FUNCTION bdy_oce_alloc() 89 !!---------------------------------------------------------------------- 90 INTEGER :: bdy_oce_alloc 91 !!---------------------------------------------------------------------- 92 ! 93 ALLOCATE( bdytmask(jpi,jpj) , tbdy(jpbdim,jpk) , sbdy(jpbdim,jpk) , & 94 & bdyumask(jpi,jpj) , ubdy(jpbdim,jpk) , & 95 & bdyvmask(jpi,jpj) , vbdy(jpbdim,jpk) , STAT=bdy_oce_alloc ) 96 ! 97 IF( lk_mpp ) CALL mpp_sum ( bdy_oce_alloc ) 98 IF( bdy_oce_alloc /= 0 ) CALL ctl_warn('bdy_oce_alloc: failed to allocate arrays.') 99 ! 100 END FUNCTION bdy_oce_alloc 81 101 82 102 #else … … 87 107 #endif 88 108 89 !!----------------------------------------------------------------------90 !! NEMO/OPA 3.3 , NEMO Consortium (2010)91 !! $Id$92 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)93 109 !!====================================================================== 94 #if defined key_bdy95 CONTAINS96 97 FUNCTION bdy_oce_alloc()98 INTEGER :: bdy_oce_alloc99 100 ALLOCATE(bdytmask(jpi,jpj), bdyumask(jpi,jpj), bdyvmask(jpi,jpj), &101 tbdy(jpbdim,jpk), sbdy(jpbdim,jpk), &102 ubdy(jpbdim,jpk), vbdy(jpbdim,jpk), &103 Stat=bdy_oce_alloc)104 105 IF(bdy_oce_alloc /= 0)THEN106 CALL ctl_warn('bdy_oce_alloc: failed to allocate arrays.')107 END IF108 109 END FUNCTION bdy_oce_alloc110 #endif111 112 110 END MODULE bdy_oce -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r2528 r2613 33 33 34 34 !!---------------------------------------------------------------------- 35 !! NEMO/OPA 3.3 , NEMO Consortium (2010)35 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 36 36 !! $Id$ 37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 38 38 !!---------------------------------------------------------------------- 39 39 CONTAINS … … 44 44 !! 45 45 !! ** Purpose : Initialization of the dynamics and tracer fields with 46 !! unstructured open boundaries.46 !! unstructured open boundaries. 47 47 !! 48 !! ** Method : Read initialization arrays (mask, indices) to identify49 !! 48 !! ** Method : Read initialization arrays (mask, indices) to identify 49 !! an unstructured open boundary 50 50 !! 51 51 !! ** Input : bdy_init.nc, input file for unstructured open boundaries 52 52 !!---------------------------------------------------------------------- 53 INTEGER :: ii, ij, ik, igrd, ib, ir ! dummy loop indices 54 INTEGER :: icount, icountr 55 INTEGER :: ib_len, ibr_max 56 INTEGER :: iw, ie, is, in 57 INTEGER :: inum ! local logical unit 58 INTEGER :: id_dummy ! local integers 59 INTEGER :: igrd_start, igrd_end ! start and end of loops on igrd 53 INTEGER :: ii, ij, ik, igrd, ib, ir ! dummy loop indices 54 INTEGER :: icount, icountr, ib_len, ibr_max ! local integers 55 INTEGER :: iw, ie, is, in, inum, id_dummy ! - - 56 INTEGER :: igrd_start, igrd_end ! - - 57 REAL(wp) :: zefl, zwfl, znfl, zsfl ! local scalars 60 58 INTEGER, DIMENSION (2) :: kdimsz 61 59 INTEGER, DIMENSION(jpbdta, jpbgrd) :: nbidta, nbjdta ! Index arrays: i and j indices of bdy dta 62 60 INTEGER, DIMENSION(jpbdta, jpbgrd) :: nbrdta ! Discrete distance from rim points 63 REAL(wp) :: zefl, zwfl, znfl, zsfl ! temporary scalars 64 REAL(wp) , DIMENSION(jpidta,jpjdta) :: zmask ! global domain mask 65 REAL(wp) , DIMENSION(jpbdta,1) :: zdta ! temporary array 66 CHARACTER(LEN=80),DIMENSION(6) :: clfile 61 REAL(wp), DIMENSION(jpidta,jpjdta) :: zmask ! global domain mask 62 REAL(wp), DIMENSION(jpbdta,1) :: zdta ! temporary array 63 CHARACTER(LEN=80),DIMENSION(6) :: clfile 67 64 !! 68 NAMELIST/nambdy/cn_mask, cn_dta_frs_T, cn_dta_frs_U, cn_dta_frs_V, 69 & cn_dta_fla_T, cn_dta_fla_U, cn_dta_fla_V, 70 & ln_tides, ln_clim, ln_vol, ln_mask, &71 & ln_dyn_fla, ln_dyn_frs, ln_tra_frs,ln_ice_frs, &65 NAMELIST/nambdy/cn_mask, cn_dta_frs_T, cn_dta_frs_U, cn_dta_frs_V, & 66 & cn_dta_fla_T, cn_dta_fla_U, cn_dta_fla_V, & 67 & ln_tides, ln_clim, ln_vol, ln_mask, & 68 & ln_dyn_fla, ln_dyn_frs, ln_tra_frs,ln_ice_frs, & 72 69 & nn_dtactl, nn_rimwidth, nn_volctl 73 70 !!---------------------------------------------------------------------- … … 77 74 IF(lwp) WRITE(numout,*) '~~~~~~~~' 78 75 ! 76 ! ! allocate bdy_oce arrays 77 IF( bdy_oce_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'bdy_init : unable to allocate arrays' ) 78 79 79 IF( jperio /= 0 ) CALL ctl_stop( 'Cyclic or symmetric,', & 80 80 & ' and unstructured open boundary condition are not compatible' ) -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r2590 r2613 7 7 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 8 8 !!---------------------------------------------------------------------- 9 #if defined key_diaar5 9 #if defined key_diaar5 || defined key_esopa 10 10 !!---------------------------------------------------------------------- 11 11 !! 'key_diaar5' : activate ar5 diagnotics … … 50 50 INTEGER :: dia_ar5_alloc 51 51 !!---------------------------------------------------------------------- 52 53 ALLOCATE(area(jpi,jpj), thick0(jpi,jpj), sn0(jpi,jpj,jpk), & 54 Stat=dia_ar5_alloc) 55 56 IF(dia_ar5_alloc /= 0)THEN 57 CALL ctl_warn('dia_ar5_alloc: failed to allocate arrays') 58 END IF 59 52 ! 53 ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc ) 54 ! 55 IF( lk_mpp ) CALL mpp_sum ( dia_ar5_alloc ) 56 IF( dia_ar5_alloc /= 0 ) CALL ctl_warn('dia_ar5_alloc: failed to allocate arrays') 57 ! 60 58 END FUNCTION dia_ar5_alloc 61 59 … … 66 64 !! 67 65 !! ** Purpose : compute and output some AR5 diagnostics 68 !!69 66 !!---------------------------------------------------------------------- 70 67 USE wrk_nemo, ONLY: wrk_use, wrk_release … … 82 79 (.NOT. wrk_use(3, 1,2)) .OR. & 83 80 (.NOT. wrk_use(4, 1)) )THEN 84 CALL ctl_stop('dia_ar5: requested workspace arrays unavailable') 85 RETURN 81 CALL ctl_stop('dia_ar5: requested workspace arrays unavailable') ; RETURN 86 82 END IF 87 83 … … 190 186 ! 191 187 IF(.NOT. wrk_use(4, 1))THEN 192 CALL ctl_stop('dia_ar5_init: requested workspace array unavailable.') 193 RETURN 188 CALL ctl_stop('dia_ar5_init: requested workspace array unavailable.') ; RETURN 194 189 END IF 195 190 zsaldta => wrk_4d_1(:,:,:,1:2) 191 192 ! ! allocate dia_ar5 arrays 193 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 196 194 197 195 area(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90
r2590 r2613 6 6 # if defined key_dimgout 7 7 !!---------------------------------------------------------------------- 8 !! * Modules used9 8 USE oce ! ocean dynamics and tracers 10 9 USE dom_oce ! ocean space and time domain … … 15 14 PRIVATE 16 15 17 !! * Accessibility18 16 PUBLIC dia_wri_dimg ! called by trd_mld (eg) 19 17 PUBLIC dia_wri_dimg_alloc ! called by nemo_alloc in nemogcm.F90 20 18 19 20 !! These workspace arrays are inside the module so that we can make them 21 !! allocatable in a clean way. Not done in wrk_nemo because these are of KIND(sp). 22 REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: z42d ! 2d temporary workspace (sp) 23 REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:) :: z4dep ! vertical level (sp) 24 21 25 !! * Substitutions 22 26 # include "domzgr_substitute.h90" 23 24 !! These workspace arrays are inside the module so that we can make them25 !! allocatable in a clean way. Not done in wrk_nemo because these are26 !! of KIND(sp).27 REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: z42d ! 2d temporary workspace (sp)28 REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:) :: z4dep ! vertical level (sp)29 30 27 !!---------------------------------------------------------------------- 31 28 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 33 30 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 34 31 !!---------------------------------------------------------------------- 35 36 32 CONTAINS 37 33 38 FUNCTION dia_wri_dimg_alloc() 39 !!--------------------------------------------------------------------- 40 !! *** ROUTINE dia_wri_dimg_alloc *** 41 !! 42 !!--------------------------------------------------------------------- 43 INTEGER :: dia_wri_dimg_alloc 44 !!--------------------------------------------------------------------- 45 46 ALLOCATE(z42d(jpi,jpj), z4dep(jpk), Stat=dia_wri_dimg_alloc) 47 48 IF(dia_wri_dimg_alloc /= 0)THEN 49 CALL ctl_warn('dia_wri_dimg_alloc: allocation of array failed.') 50 END IF 51 34 FUNCTION dia_wri_dimg_alloc() 35 !!--------------------------------------------------------------------- 36 !! *** ROUTINE dia_wri_dimg_alloc *** 37 !! 38 !!--------------------------------------------------------------------- 39 INTEGER :: dia_wri_dimg_alloc ! return value 40 !!--------------------------------------------------------------------- 41 ! 42 ALLOCATE( z42d(jpi,jpj), z4dep(jpk), STAT=dia_wri_dimg_alloc ) 43 ! 44 IF( lk_mpp ) CALL mpp_sum ( dia_wri_dimg_alloc ) 45 IF( dia_wri_dimg_alloc /= 0 ) CALL ctl_warn('dia_wri_dimg_alloc: allocation of array failed.') 46 ! 52 47 END FUNCTION dia_wri_dimg_alloc 53 48 54 49 55 SUBROUTINE dia_wri_dimg( cd_name, cd_text, ptab, klev, cd_type , ksubi )50 SUBROUTINE dia_wri_dimg( cd_name, cd_text, ptab, klev, cd_type , ksubi ) 56 51 !!------------------------------------------------------------------------- 57 52 !! *** ROUTINE dia_wri_dimg *** 58 53 !! 59 !! ** Purpose : write ptab in the dimg file cd_name, with comment cd_text.60 !! ptab has klev x 2D fields54 !! ** Purpose : write ptab in the dimg file cd_name, with comment cd_text. 55 !! ptab has klev x 2D fields 61 56 !! 62 !! ** Action : 63 !! Define header variables from the config parameters 64 !! Open the dimg file on unit inum = 14 ( IEEE I4R4 file ) 65 !! Write header on record 1 66 !! Write ptab on the following klev records 57 !! ** Action : Define header variables from the config parameters 58 !! Open the dimg file on unit inum = 14 ( IEEE I4R4 file ) 59 !! Write header on record 1 60 !! Write ptab on the following klev records 67 61 !! 68 !! History : 69 !! 03-12 (J.M. Molines ) : Original. Replace ctl_opn, writn2d 62 !! History : 2003-12 (J.M. Molines ) : Original. Replace ctl_opn, writn2d 70 63 !!--------------------------------------------------------------------------- 71 !! * Arguments72 64 CHARACTER(len=*),INTENT(in) :: & 73 65 & cd_name, & ! dimg file name … … 91 83 CHARACTER(LEN=4) :: clver='@!01' ! dimg string identifier 92 84 !!--------------------------------------------------------------------------- 85 86 ! ! allocate dia_wri_dimg array 87 IF( dia_wri_dimg_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_wri_dimg : unable to allocate arrays' ) 93 88 94 89 !! * Initialisations -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
r2590 r2613 21 21 USE phycst ! physical constants 22 22 USE in_out_manager ! I/O manager 23 USE lib_mpp ! MPP library 23 24 USE iom ! I/O library 24 25 … … 29 30 PUBLIC dia_hth_alloc ! routine called by nemogcm.F90 30 31 31 LOGICAL , PUBLIC, PARAMETER :: lk_diahth = .TRUE. !: thermocline-20d depths flag32 LOGICAL , PUBLIC, PARAMETER :: lk_diahth = .TRUE. !: thermocline-20d depths flag 32 33 ! note: following variables should move to local variables once iom_put is always used 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hth 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hd20 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hd28 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: htc3 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hth !: depth of the max vertical temperature gradient [m] 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hd20 !: depth of 20 C isotherm [m] 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hd28 !: depth of 28 C isotherm [m] 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: htc3 !: heat content of first 300 m [W] 37 38 38 39 !! * Substitutions 39 40 # include "domzgr_substitute.h90" 40 41 !!---------------------------------------------------------------------- 41 !! NEMO/OPA 3.3 , NEMO Consortium (2010)42 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 42 43 !! $Id$ 43 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 46 47 47 48 FUNCTION dia_hth_alloc() 48 !!--------------------------------------------------------------------- 49 IMPLICIT none 49 !!--------------------------------------------------------------------- 50 50 INTEGER :: dia_hth_alloc 51 52 ALLOCATE(hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), &53 Stat=dia_hth_alloc)54 55 IF( dia_hth_alloc /= 0)THEN56 CALL ctl_warn('dia_hth_alloc: failed to allocate arrays.')57 END IF51 !!--------------------------------------------------------------------- 52 ! 53 ALLOCATE(hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), STAT=dia_hth_alloc) 54 ! 55 IF( lk_mpp ) CALL mpp_sum ( dia_hth_alloc ) 56 IF(dia_hth_alloc /= 0) CALL ctl_warn('dia_hth_alloc: failed to allocate arrays.') 57 ! 58 58 END FUNCTION dia_hth_alloc 59 59 … … 117 117 zmaxdzT(jpi,jpj), & 118 118 zthick(jpi,jpj), & 119 zdelr(jpi,jpj), Stat=ji) 120 IF(ji /= 0)THEN 121 WRITE(*,*) 'ERROR: allocation of arrays failed in dia_hth' 122 CALL mppabort() 123 END IF 119 zdelr(jpi,jpj), STAT=ji) 120 IF( lk_mpp ) CALL mpp_sum(ji) 121 IF( ji /= 0 ) CALL ctl_stop( 'STOP', 'dia_hth : unable to allocate standard ocean arrays' ) 124 122 END IF 125 123 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r2590 r2613 75 75 CONTAINS 76 76 77 FUNCTION dia_wri_alloc() 78 !!---------------------------------------------------------------------- 79 IMPLICIT none 80 INTEGER :: dia_wri_alloc 81 INTEGER, DIMENSION(2) :: ierr 82 !!---------------------------------------------------------------------- 83 84 ierr = 0 85 86 ALLOCATE(ndex_hT(jpi*jpj), ndex_hU(jpi*jpj), ndex_hV(jpi*jpj), & 87 ndex_T(jpi*jpj*jpk), ndex_U(jpi*jpj*jpk), ndex_V(jpi*jpj*jpk), & 88 Stat=ierr(1)) 89 90 dia_wri_alloc = MAXVAL(ierr) 91 77 FUNCTION dia_wri_alloc() 78 !!---------------------------------------------------------------------- 79 IMPLICIT none 80 INTEGER :: dia_wri_alloc 81 INTEGER, DIMENSION(2) :: ierr 82 !!---------------------------------------------------------------------- 83 ! 84 ierr = 0 85 ! 86 ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) , & 87 & ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) , & 88 & ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 89 ! 90 dia_wri_alloc = MAXVAL(ierr) 91 IF( lk_mpp ) CALL mpp_sum( ierr ) 92 ! 92 93 END FUNCTION dia_wri_alloc 93 94 … … 106 107 !! 'key_iomput' use IOM library 107 108 !!---------------------------------------------------------------------- 109 108 110 SUBROUTINE dia_wri( kt ) 109 111 !!--------------------------------------------------------------------- -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90
r2590 r2613 69 69 INTEGER ,INTENT(in) :: kt 70 70 !! 71 INTEGER :: inbsel, jk72 INTEGER :: iyear,imon,iday73 INTEGER, SAVE :: nmoyct74 75 71 #if defined key_diainstant 76 72 LOGICAL, PARAMETER :: ll_dia_inst=.TRUE. !: for instantaneous output … … 78 74 LOGICAL, PARAMETER :: ll_dia_inst=.FALSE. !: for average output 79 75 #endif 80 81 REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: um , vm ! used to compute mean u, v fields 82 REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: wm ! used to compute mean w fields 83 REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: avtm ! used to compute mean kz fields 84 REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: tm , sm ! used to compute mean t, s fields 85 REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: fsel ! used to compute mean 2d fields 76 INTEGER , SAVE :: nmoyct 77 REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: um , vm, wm ! mean u, v, w fields 78 REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: avtm ! mean kz fields 79 REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: tm , sm ! mean t, s fields 80 REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: fsel ! mean 2d fields 81 82 INTEGER :: inbsel, jk 83 INTEGER :: iyear,imon,iday 86 84 REAL(wp) :: zdtj 87 !88 85 CHARACTER(LEN=80) :: clname 89 86 CHARACTER(LEN=80) :: cltext … … 260 257 cltext=TRIM(cexper)//' U(m/s) '//TRIM(clmode) 261 258 ! 262 IF( ll_dia_inst) THEN 263 CALL dia_wri_dimg(clname, cltext, un, jpk, 'T') 264 265 ELSE 266 CALL dia_wri_dimg(clname, cltext, um, jpk, 'T') 259 IF( ll_dia_inst) THEN ; CALL dia_wri_dimg(clname, cltext, un, jpk, 'T') 260 ELSE ; CALL dia_wri_dimg(clname, cltext, um, jpk, 'T') 267 261 ENDIF 268 262 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r2590 r2613 72 72 !! *** routine dyn_spg_ts_alloc *** 73 73 !!---------------------------------------------------------------------- 74 IMPLICIT none 75 INTEGER :: dyn_spg_ts_malloc 74 INTEGER :: dyn_spg_ts_alloc ! return value 76 75 !!---------------------------------------------------------------------- 77 76 ! 78 77 ALLOCATE(ftnw(jpi,jpj), ftne(jpi,jpj), ftsw(jpi,jpj), ftse(jpi,jpj), & 79 un_b(jpi,jpj), vn_b(jpi,jpj), ub_b(jpi,jpj), vb_b(jpi,jpj), &80 Stat=dyn_spg_ts_malloc)81 82 END FUNCTION dyn_spg_ts_ malloc78 & un_b(jpi,jpj), vn_b(jpi,jpj), ub_b(jpi,jpj), vb_b(jpi,jpj), & 79 & STAT=dyn_spg_ts_alloc) 80 ! 81 END FUNCTION dyn_spg_ts_alloc 83 82 84 83 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90
r2590 r2613 16 16 PUBLIC 17 17 18 PUBLIC flo_oce_alloc! Routine called in nemogcm.F9018 PUBLIC flo_oce_alloc ! Routine called in nemogcm.F90 19 19 20 20 LOGICAL, PUBLIC, PARAMETER :: lk_floats = .TRUE. !: float flag … … 34 34 REAL(wp), PUBLIC, DIMENSION(jpnfl) :: tpifl, tpjfl, tpkfl !: (i,j,k) indices of float position 35 35 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wb 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wb !: vertical velocity at previous time step (m s-1). 37 37 38 38 ! !!! * namelist namflo : langrangian floats * … … 43 43 INTEGER, PUBLIC :: nn_stockfl = 450 !: frequency of float restart file 44 44 45 !!---------------------------------------------------------------------- 45 46 CONTAINS 46 47 47 48 FUNCTION flo_oce_alloc() 48 IMPLICIT none 49 INTEGER :: flo_oce_alloc 50 51 ALLOCATE(wb(jpi,jpj,jpk), Stat=flo_oce_alloc) 52 49 !!---------------------------------------------------------------------- 50 INTEGER :: flo_oce_alloc 51 !!---------------------------------------------------------------------- 52 ! 53 ALLOCATE(wb(jpi,jpj,jpk), Stat=flo_oce_alloc) 54 ! 53 55 END FUNCTION flo_oce_alloc 54 56 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
r2590 r2613 24 24 25 25 PUBLIC flo_wri ! routine called by floats.F90 26 PUBLIC flo w_wri_alloc ! routine called by nemogcm.F9026 PUBLIC flo_wri_alloc ! routine called by nemogcm.F90 27 27 28 28 INTEGER :: jfl ! number of floats … … 37 37 # include "domzgr_substitute.h90" 38 38 !!---------------------------------------------------------------------- 39 !! NEMO/OPA 3.3 , NEMO Consortium (2010)39 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 40 40 !! $Id$ 41 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 43 43 CONTAINS 44 44 45 FUNCTION flo w_wri_alloc45 FUNCTION flo_wri_alloc 46 46 !!------------------------------------------------------------------- 47 47 !! *** ROUTINE flo_wri_alloc *** 48 48 !!------------------------------------------------------------------- 49 INTEGER :: flo w_wri_alloc50 51 ALLOCATE(ztemp(jpk,jpnfl), zsal(jpk,jpnfl), Stat=flow_wri_alloc)52 53 IF(flow_wri_alloc /= 0)THEN54 CALL ctl_warn('flow_wri_alloc: failed to allocate arrays.')55 END IF56 57 END FUNCTION flo w_wri_alloc49 INTEGER :: flo_wri_alloc 50 !!------------------------------------------------------------------- 51 ! 52 ALLOCATE(ztemp(jpk,jpnfl), zsal(jpk,jpnfl), Stat=flo_wri_alloc) 53 ! 54 IF( lk_mpp ) CALL mpp_sum ( flo_wri_alloc ) 55 IF( flo_wri_alloc /= 0 ) CALL ctl_warn('flo_wri_alloc: failed to allocate arrays.') 56 ! 57 END FUNCTION flo_wri_alloc 58 58 59 59 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r2528 r2613 20 20 USE lib_print ! formated print library 21 21 USE nc4interface ! NetCDF4 interface 22 USE lib_mpp, ONLY : lk_mpp 22 23 23 24 IMPLICIT NONE … … 137 138 CONTAINS 138 139 139 SUBROUTINE ctl_stop( cd 1, cd2, cd3, cd4, cd5, &140 & cd6, cd7, cd8, cd9, cd10 )140 SUBROUTINE ctl_stop( cd_stop, cd1, cd2, cd3, cd4, cd5 , & 141 & cd6, cd7, cd8, cd9, cd10 ) 141 142 !!---------------------------------------------------------------------- 142 143 !! *** ROUTINE stop_opa *** … … 145 146 !! increment the error number (nstop) by one. 146 147 !!---------------------------------------------------------------------- 147 CHARACTER(len=*), INTENT(in), OPTIONAL :: cd 1, cd2, cd3, cd4, cd5148 CHARACTER(len=*), INTENT(in), OPTIONAL :: cd6, cd7, cd8, cd9, cd10148 CHARACTER(len=*), INTENT(in), OPTIONAL :: cd_stop, cd1, cd2, cd3, cd4, cd5 149 CHARACTER(len=*), INTENT(in), OPTIONAL :: cd6, cd7, cd8, cd9, cd10 149 150 !!---------------------------------------------------------------------- 150 151 ! … … 167 168 IF( numsol /= -1 ) CALL FLUSH(numsol ) 168 169 IF( numevo_ice /= -1 ) CALL FLUSH(numevo_ice) 170 ! 171 IF( PRESENT(cd_stop) ) THEN 172 IF( cd_stop == 'STOP' ) THEN 173 WRITE(numout,*) 174 WRITE(numout,*) 'huge E-R-R-O-R : immediate stop' 175 IF(lk_mpp) CALL mppstop() 176 STOP 177 ENDIF 178 ENDIF 169 179 ! 170 180 END SUBROUTINE ctl_stop -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r2590 r2613 2 2 !!====================================================================== 3 3 !! *** MODULE sbc_ice *** 4 !! parameter and variables defined in memory in forced mode4 !! Surface module - LIM-3: parameters & variables defined in memory 5 5 !!====================================================================== 6 !! History : 3.0 ! 2006-08 (G. Madec) Surface module 7 !! 3.2 ! 2009-06 (S. Masson) merge with ice_oce 6 !! History : 3.0 ! 2006-08 (G. Madec) Surface module 7 !! 3.2 ! 2009-06 (S. Masson) merge with ice_oce 8 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_lim3 || defined key_lim2 … … 13 14 USE par_oce ! ocean parameters 14 15 # if defined key_lim3 15 USE par_ice ! iceparameters16 USE par_ice ! LIM-3 parameters 16 17 # endif 17 18 # if defined key_lim2 18 USE par_ice_2 ! iceparameters19 USE par_ice_2 ! LIM-2 parameters 19 20 # endif 20 21 … … 39 40 # endif 40 41 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qns_ice !: non solar heat flux over ice 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice !: solar heat flux over ice 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qla_ice !: latent flux over ice 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqla_ice !: latent sensibility over ice 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqns_ice !: non solar heat flux sensibility over ice (LW+SEN+LA)[W/m2/K]46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice !: ice surface temperature 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qns_ice !: non solar heat flux over ice [W/m2] 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice !: solar heat flux over ice [W/m2] 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qla_ice !: latent flux over ice [W/m2] 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqla_ice !: latent sensibility over ice [W/m2/K] 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqns_ice !: non solar heat flux over ice (LW+SEN+LA) [W/m2/K] 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice !: ice surface temperature [K] 47 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: alb_ice !: albedo of ice 48 49 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_ice !: u-stress over ice (I-pt for VP or U,V-pts for EVP)[N/m2]50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtau_ice !: v-stress over ice (I-pt for VP or U,V-pts for EVP)[N/m2]51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr1_i0 !: 1st fraction of Qsr which penetrates inside the ice cover52 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr2_i0 !: 2nd fraction of Qsr which penetrates inside the ice cover53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: s olid freshwater budget over ice: sublivation - snow50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_ice !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts [N/m2] 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtau_ice !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts [N/m2] 52 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr1_i0 !: 1st Qsr fraction penetrating inside ice cover [-] 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr2_i0 !: 2nd Qsr fraction penetrating inside ice cover [-] 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation-snow budget over ice [kg/m2] 54 55 55 56 # if defined key_lim3 … … 57 58 # endif 58 59 60 !!---------------------------------------------------------------------- 61 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 62 !! $Id$ 63 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 64 !!---------------------------------------------------------------------- 59 65 CONTAINS 60 66 61 FUNCTION sbc_ice_alloc() 62 !!---------------------------------------------------------------------- 63 !!---------------------------------------------------------------------- 64 IMPLICIT none 65 INTEGER :: sbc_ice_alloc 66 !!---------------------------------------------------------------------- 67 68 ALLOCATE(qns_ice(jpi,jpj,jpl), qsr_ice(jpi,jpj,jpl), & 69 qla_ice(jpi,jpj,jpl), dqla_ice(jpi,jpj,jpl), & 70 dqns_ice(jpi,jpj,jpl), tn_ice(jpi,jpj,jpl), & 71 alb_ice(jpi,jpj,jpl), & 72 utau_ice(jpi,jpj), vtau_ice(jpi,jpj), fr1_i0(jpi,jpj), & 73 fr2_i0(jpi,jpj), emp_ice(jpi,jpj), & 74 Stat=sbc_ice_alloc) 75 67 FUNCTION sbc_ice_alloc() 68 !!---------------------------------------------------------------------- 69 !! *** FUNCTION sbc_ice_alloc *** 70 !! 71 !! ** Purpose : Allocate all the dynamic arrays in the modules 72 !!---------------------------------------------------------------------- 73 INTEGER :: sbc_ice_alloc ! return value 74 !!---------------------------------------------------------------------- 75 ! 76 ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) , & 77 & qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) , & 78 & dqns_ice(jpi,jpj,jpl) , tn_ice (jpi,jpj,jpl) , & 79 & alb_ice (jpi,jpj,jpl) , & 80 & utau_ice(jpi,jpj) , vtau_ice(jpi,jpj) , & 81 & fr1_i0 (jpi,jpj) , fr2_i0 (jpi,jpj) , & 82 & emp_ice(jpi,jpj) , STAT=sbc_ice_alloc) 83 ! 76 84 END FUNCTION sbc_ice_alloc 77 85 … … 85 93 #endif 86 94 87 !!----------------------------------------------------------------------88 !! NEMO/OPA 3.3 , NEMO Consortium (2010)89 !! $Id$90 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)91 95 !!====================================================================== 92 96 END MODULE sbc_ice -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r2599 r2613 63 63 # include "vectopt_loop_substitute.h90" 64 64 !!---------------------------------------------------------------------- 65 !! NEMO/OPA 4.0 , UCL NEMO Consortium (201 0)65 !! NEMO/OPA 4.0 , UCL NEMO Consortium (2011) 66 66 !! $Id$ 67 67 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 146 146 CASE( 3 ) ! CLIO bulk formulation 147 147 CALL blk_ice_clio( t_su , zalb_ice_cs, zalb_ice_os, & 148 & utau_ice , vtau_ice, qns_ice , qsr_ice , &149 & qla_ice , dqns_ice, dqla_ice , &150 & tprecip , sprecip, &151 & fr1_i0 , fr2_i0, cp_ice_msh, jpl )148 & utau_ice , vtau_ice , qns_ice , qsr_ice , & 149 & qla_ice , dqns_ice , dqla_ice , & 150 & tprecip , sprecip , & 151 & fr1_i0 , fr2_i0 , cp_ice_msh, jpl ) 152 152 ! 153 153 CASE( 4 ) ! CORE bulk formulation 154 154 CALL blk_ice_core( t_su , u_ice , v_ice , zalb_ice_cs, & 155 & utau_ice , vtau_ice , qns_ice , qsr_ice , &156 & qla_ice , dqns_ice , dqla_ice , &157 & tprecip , sprecip , &155 & utau_ice , vtau_ice , qns_ice , qsr_ice , & 156 & qla_ice , dqns_ice , dqla_ice , & 157 & tprecip , sprecip , & 158 158 & fr1_i0 , fr2_i0 , cp_ice_msh, jpl ) 159 159 END SELECT -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
r2594 r2613 57 57 INTEGER :: tra_ldf_iso_grif_alloc 58 58 !!---------------------------------------------------------------------- 59 59 ! 60 60 ALLOCATE(zdkt(jpi,jpj,0:1), Stat=tra_ldf_iso_grif_alloc) 61 62 IF(tra_ldf_iso_grif_alloc /= 0)THEN 63 CALL ctl_warn('tra_ldf_iso_grif_alloc : allocation of arrays failed.') 64 END IF 65 61 ! 62 IF( tra_ldf_iso_grif_alloc /= 0 ) CALL ctl_warn('tra_ldf_iso_grif_alloc : allocation of arrays failed.') 63 ! 66 64 END FUNCTION tra_ldf_iso_grif_alloc 67 65 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90
r2590 r2613 72 72 INTEGER :: trd_mld_alloc 73 73 !!---------------------------------------------------------------------- 74 74 ! 75 75 ALLOCATE(ndextrd1(jpi*jpj), Stat=trd_mld_alloc) 76 77 IF(trd_mld_alloc /= 0)THEN 78 CALL ctl_warn('trd_mld_alloc: failed to allocate array ndextrd1.') 79 END IF 80 76 ! 77 IF( trd_mld_alloc /= 0 ) CALL ctl_warn('trd_mld_alloc: failed to allocate array ndextrd1.') 78 ! 81 79 END FUNCTION trd_mld_alloc 80 82 81 83 82 SUBROUTINE trd_mld_zint( pttrdmld, pstrdmld, ktrd, ctype ) … … 262 261 USE wrk_nemo, ONLY: ztmltot2 => wrk_2d_7, ztmlres2 => wrk_2d_8, ztmltrdm2 => wrk_2d_9 ! \ working arrays to diagnose the trends 263 262 USE wrk_nemo, ONLY: zsmltot2 => wrk_2d_10, zsmlres2 => wrk_2d_11, zsmltrdm2 => wrk_2d_12 ! > associated with the time meaned ML T & S 264 USE wrk_nemo, ONLY: ztmlatf2 => wrk_2d_13, zsmlatf2 => wrk_2d_14 ! / 263 USE wrk_nemo, ONLY: ztmlatf2 => wrk_2d_13, zsmlatf2 => wrk_2d_14 264 USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2 ! / 265 265 !! 266 266 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 269 269 LOGICAL :: lldebug = .TRUE. 270 270 REAL(wp) :: zavt, zfn, zfn2 271 REAL(wp), POINTER, DIMENSION(:,:,:) :: & 272 ztmltrd2, zsmltrd2 ! only needed for mean diagnostics 271 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmltrd2, zsmltrd2 ! only needed for mean diagnostics 273 272 #if defined key_dimgout 274 273 INTEGER :: iyear,imon,iday … … 282 281 CALL ctl_stop('trd_mld : requested workspace arrays unavailable.') 283 282 RETURN 284 ELSE IF(jpltrd > jpk) 283 ELSE IF(jpltrd > jpk) THEN 285 284 ! ARPDBG, is this reasonable or will this cause trouble in the future? 286 285 CALL ctl_stop('trd_mld : no. of mixed-layer trends (jpltrd) exceeds no. of model levels so cannot use 3D workspaces.') … … 288 287 END IF 289 288 ! Set-up pointers into sub-arrays of 3d-workspaces 290 ztmltrd2 => wrk_3d_1( :,:,1:jpltrd)291 zsmltrd2 => wrk_3d_2( :,:,1:jpltrd)289 ztmltrd2 => wrk_3d_1(1:,:,1:jpltrd) 290 zsmltrd2 => wrk_3d_2(1:,:,1:jpltrd) 292 291 293 292 ! ====================================================================== -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce.F90
r2590 r2613 71 71 tmlatfm, smlatfm !: accumulator for Asselin trends (needed for storage only) 72 72 73 REAL(wp), PUBLIC, DIMENSION(:,:,:) :: &73 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: & 74 74 tmltrd, & !: \ physical contributions to the total trend (for T/S), 75 75 smltrd, & !: / cumulated over the current analysis window … … 82 82 #endif 83 83 !!---------------------------------------------------------------------- 84 !! NEMO/OPA 3.3 , NEMO Consortium (2010)84 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 85 85 !! $Id$ 86 86 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 87 !! ======================================================================87 !!---------------------------------------------------------------------- 88 88 CONTAINS 89 89 … … 92 92 !!---------------------------------------------------------------------- 93 93 USE in_out_manager, ONLY: ctl_warn 94 IMPLICIT none95 94 INTEGER :: trdmld_oce_alloc 96 95 INTEGER :: ierr(5) … … 104 103 105 104 #if defined key_trdmld || defined key_esopa 106 ALLOCATE( nmld(jpi,jpj), nbol(jpi,jpj), &107 wkx(jpi,jpj,jpk), rmld(jpi,jpj), &108 tml(jpi,jpj) , sml(jpi,jpj), &109 tmlb(jpi,jpj) , smlb(jpi,jpj) , &110 tmlbb(jpi,jpj) , smlbb(jpi,jpj), &111 Stat = ierr(1))105 ALLOCATE( nmld(jpi,jpj), nbol(jpi,jpj), & 106 & wkx(jpi,jpj,jpk), rmld(jpi,jpj), & 107 & tml(jpi,jpj) , sml(jpi,jpj), & 108 & tmlb(jpi,jpj) , smlb(jpi,jpj) , & 109 & tmlbb(jpi,jpj) , smlbb(jpi,jpj), & 110 & Stat = ierr(1)) 112 111 113 ALLOCATE( tmlbn(jpi,jpj) , smlbn(jpi,jpj), &114 tmltrdm(jpi,jpj), smltrdm(jpi,jpj), &115 tml_sum(jpi,jpj), tml_sumb(jpi,jpj),&116 tmltrd_atf_sumb(jpi,jpj), Stat=ierr(2))112 ALLOCATE( tmlbn(jpi,jpj) , smlbn(jpi,jpj), & 113 & tmltrdm(jpi,jpj), smltrdm(jpi,jpj), & 114 & tml_sum(jpi,jpj), tml_sumb(jpi,jpj),& 115 & tmltrd_atf_sumb(jpi,jpj), Stat=ierr(2)) 117 116 118 ALLOCATE( sml_sum(jpi,jpj), sml_sumb(jpi,jpj), &119 smltrd_atf_sumb(jpi,jpj), &120 rmld_sum(jpi,jpj), rmldbn(jpi,jpj), &121 tmlatfb(jpi,jpj), tmlatfn(jpi,jpj), &122 Stat = ierr(3))117 ALLOCATE( sml_sum(jpi,jpj), sml_sumb(jpi,jpj), & 118 & smltrd_atf_sumb(jpi,jpj), & 119 & rmld_sum(jpi,jpj), rmldbn(jpi,jpj), & 120 & tmlatfb(jpi,jpj), tmlatfn(jpi,jpj), & 121 & Stat = ierr(3)) 123 122 124 ALLOCATE( smlatfb(jpi,jpj), smlatfn(jpi,jpj), &125 tmlatfm(jpi,jpj), smlatfm(jpi,jpj), &126 tmltrd(jpi,jpj,jpltrd), smltrd(jpi,jpj,jpltrd), &127 Stat=ierr(4))123 ALLOCATE( smlatfb(jpi,jpj), smlatfn(jpi,jpj), & 124 & tmlatfm(jpi,jpj), smlatfm(jpi,jpj), & 125 & tmltrd(jpi,jpj,jpltrd), smltrd(jpi,jpj,jpltrd), & 126 & Stat=ierr(4)) 128 127 129 ALLOCATE( tmltrd_sum(jpi,jpj,jpltrd),tmltrd_csum_ln(jpi,jpj,jpltrd), &130 tmltrd_csum_ub(jpi,jpj,jpltrd), smltrd_sum(jpi,jpj,jpltrd), &131 smltrd_csum_ln(jpi,jpj,jpltrd), smltrd_csum_ub(jpi,jpj,jpltrd), &132 Stat=ierr(5))128 ALLOCATE( tmltrd_sum(jpi,jpj,jpltrd),tmltrd_csum_ln(jpi,jpj,jpltrd), & 129 & tmltrd_csum_ub(jpi,jpj,jpltrd), smltrd_sum(jpi,jpj,jpltrd), & 130 & smltrd_csum_ln(jpi,jpj,jpltrd), smltrd_csum_ub(jpi,jpj,jpltrd), & 131 & Stat=ierr(5)) 133 132 #endif 133 ! 134 trdmld_oce_alloc = MAXVAL(ierr) 135 ! 136 IF( trdmld_oce_alloc /= 0 ) CALL ctl_warn('trdmld_oce_alloc: failed to allocate arrays.') 137 ! 138 END FUNCTION trdmld_oce_alloc 134 139 135 trdmld_oce_alloc = MAXVAL(ierr) 136 137 IF(trdmld_oce_alloc /= 0)THEN 138 CALL ctl_warn('trdmld_oce_alloc: failed to allocate arrays.') 139 END IF 140 141 END FUNCTION trdmld_oce_alloc 142 140 !!====================================================================== 143 141 END MODULE trdmld_oce -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90
r2590 r2613 58 58 z2dx => wrk_2d_5, & 59 59 z2dy => wrk_2d_6 60 IMPLICIT none61 INTEGER, INTENT( in ) :: kt ! time step62 INTEGER, INTENT( in ) :: ktrd ! tracer trend index63 CHARACTER(len=3) , INTENT( in ) :: ctype! momentum or tracers trends type 'DYN'/'TRA'64 REAL(wp), DIMENSION(:,:,:), INTENT( inout ) :: ptrdx ! Temperature or U trend65 REAL(wp), DIMENSION(:,:,:), INTENT( inout ) :: ptrdy ! Salinity or V trend60 ! 61 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdx ! Temperature or U trend 62 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdy ! Salinity or V trend 63 CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum or tracers trends type 'DYN'/'TRA' 64 INTEGER , INTENT(in ) :: kt ! time step 65 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 66 66 !! 67 INTEGER :: ji, jj 67 INTEGER :: ji, jj ! dummy loop indices 68 68 !!---------------------------------------------------------------------- 69 69 70 70 IF(.not. wrk_use(2, 1,2,3,4,5,6))THEN 71 CALL ctl_error('trd_mod: Requested workspace arrays already in use.') 72 RETURN 71 CALL ctl_warn('trd_mod: Requested workspace arrays already in use.') ; RETURN 73 72 END IF 74 73 75 z2dx(:,:) = 0.e0 ; z2dy(:,:) = 0.e0! initialization of workspace arrays76 77 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra (restartingwith Euler time stepping)78 ELSEIF( kt <= nit000 + 1) THEN ; r2dt = 2. * rdt 74 z2dx(:,:) = 0._wp ; z2dy(:,:) = 0._wp ! initialization of workspace arrays 75 76 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra (restart with Euler time stepping) 77 ELSEIF( kt <= nit000 + 1) THEN ; r2dt = 2. * rdt ! = 2 rdttra (leapfrog) 79 78 ENDIF 80 79 … … 94 93 CASE ( jptra_trd_dmp ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_dmp, ctype ) ! damping 95 94 CASE ( jptra_trd_qsr ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_qsr, ctype ) ! penetrative solar radiat. 96 CASE ( jptra_trd_nsr ) 97 z2dx(:,:) = ptrdx(:,:,1) ;z2dy(:,:) = ptrdy(:,:,1)98 CALL trd_icp( z2dx, z2dy, jpicpt_nsr, ctype )! non solar radiation95 CASE ( jptra_trd_nsr ) ; z2dx(:,:) = ptrdx(:,:,1) 96 z2dy(:,:) = ptrdy(:,:,1) 97 CALL trd_icp( z2dx , z2dy , jpicpt_nsr, ctype ) ! non solar radiation 99 98 CASE ( jptra_trd_xad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_xad, ctype ) ! x- horiz adv 100 99 CASE ( jptra_trd_yad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_yad, ctype ) ! y- horiz adv 101 CASE ( jptra_trd_zad ) 102 CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype )103 ! compute the surface flux condition wn(:,:,1)*tn(:,:,1)104 z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1)105 z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1)106 CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype )! 1st z- vertical adv100 CASE ( jptra_trd_zad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype ) ! z- vertical adv 101 CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype ) 102 ! compute the surface flux condition wn(:,:,1)*tn(:,:,1) 103 z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1) 104 z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1) 105 CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype ) ! 1st z- vertical adv 107 106 END SELECT 108 107 END IF … … 123 122 ! subtract surface forcing/bottom friction trends 124 123 ! from vertical diffusive momentum trends 125 ztswu(:,:) = 0. e0 ; ztswv(:,:) = 0.e0126 ztbfu(:,:) = 0. e0 ; ztbfv(:,:) = 0.e0124 ztswu(:,:) = 0._wp ; ztswv(:,:) = 0._wp 125 ztbfu(:,:) = 0._wp ; ztbfv(:,:) = 0._wp 127 126 DO jj = 2, jpjm1 128 127 DO ji = fs_2, fs_jpim1 ! vector opt. … … 131 130 ztswv(ji,jj) = vtau(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) 132 131 ! bottom friction contribution now handled explicitly 133 ! 134 ptrdx(ji,jj,1 ) = ptrdx(ji,jj,1 ) - ztswu(ji,jj) 135 ptrdy(ji,jj,1 ) = ptrdy(ji,jj,1 ) - ztswv(ji,jj) 132 ptrdx(ji,jj,1) = ptrdx(ji,jj,1) - ztswu(ji,jj) 133 ptrdy(ji,jj,1) = ptrdy(ji,jj,1) - ztswv(ji,jj) 136 134 END DO 137 135 END DO … … 228 226 ENDIF 229 227 ! 230 IF(.not. wrk_release(2, 1,2,3,4,5,6))THEN 231 CALL ctl_error('trd_mod: Failed to release workspace arrays.') 232 END IF 228 IF( .not. wrk_release(2, 1,2,3,4,5,6) ) CALL ctl_warn('trd_mod: Failed to release workspace arrays.') 233 229 ! 234 230 END SUBROUTINE trd_mod … … 242 238 USE trdicp ! ocean bassin integral constraints properties 243 239 USE trdmld ! ocean active mixed layer tracers trends 244 240 !!---------------------------------------------------------------------- 245 241 CONTAINS 246 242 SUBROUTINE trd_mod(ptrd3dx, ptrd3dy, ktrd , ctype, kt ) ! Empty routine -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90
r2590 r2613 225 225 zustar => wrk_2d_3 226 226 USE wrk_nemo, ONLY: zmask => wrk_2d_4 227 USE wrk_nemo, ONLY: wrk_2d_5, wrk_2d_6, wrk_2d_7, wrk_2d_8, wrk_2d_9, & 227 !gm USE wrk_nemo, ONLY: wrk_2d_5, wrk_2d_6, wrk_2d_7, wrk_2d_8, wrk_2d_9, & 228 USE wrk_nemo, ONLY: wrk_2d_6, wrk_2d_7, wrk_2d_8, wrk_2d_9, & 228 229 wrk_2d_10,wrk_2d_11 229 230 USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_2, wrk_1d_3, wrk_1d_4, & … … 260 261 REAL(wp) :: zflag, ztemp, zrn2, zdep21, zdep32, zdep43 261 262 REAL(wp) :: zdku2, zdkv2, ze3sqr, zsh2, zri, zfri ! Interior richardson mixing 262 REAL(wp), POINTER, DIMENSION(:,:) :: zmoek ! Moning-Obukov limitation 263 !gm REAL(wp), POINTER, DIMENSION(:,:) :: zmoek ! Moning-Obukov limitation 264 REAL(wp), DIMENSION(jpi,0:2) :: zmoek ! Moning-Obukov limitation 263 265 REAL(wp), POINTER, DIMENSION(:) :: zmoa, zekman 264 266 REAL(wp) :: zmob, zek … … 285 287 END IF 286 288 ! Set-up pointers to 2D spaces 287 zmoek(1:jpi,0:2) => wrk_2d_5(1:jpi,1:3)289 !gm zmoek(1:jpi,0:2) => wrk_2d_5(1:jpi,1:3) 288 290 zdepw => wrk_2d_6(:,1:4) 289 291 zdift => wrk_2d_7(:,1:4) -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
r2590 r2613 31 31 PUBLIC zdf_ric ! called by step.F90 32 32 PUBLIC zdf_ric_init ! called by opa.F90 33 PUBLIC zdf_ric_alloc ! called by nemogcm.F90 33 34 34 35 LOGICAL, PUBLIC, PARAMETER :: lk_zdfric = .TRUE. !: Richardson vertical mixing flag -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r2608 r2613 101 101 !! - finalize the run by closing files and communications 102 102 !! 103 !! References : Madec, Delecluse, Imbard, and Levy, 1997: internal report, IPSL.103 !! References : Madec, Delecluse, Imbard, and Levy, 1997: internal report, IPSL. 104 104 !! Madec, 2008, internal report, IPSL. 105 105 !!---------------------------------------------------------------------- … … 183 183 !! ** Purpose : initialization of the NEMO GCM 184 184 !!---------------------------------------------------------------------- 185 INTEGER :: ji ! dummy loop indices186 INTEGER :: ilocal_comm ! local integer185 INTEGER :: ji ! dummy loop indices 186 INTEGER :: ilocal_comm ! local integer 187 187 CHARACTER(len=80), DIMENSION(10) :: cltxt 188 188 !! … … 456 456 END SUBROUTINE nemo_closefile 457 457 458 !!======================================================================459 458 460 459 SUBROUTINE nemo_alloc … … 462 461 !! *** ROUTINE nemo_alloc *** 463 462 !! 464 !! ** Purpose : Allocate all the dynamic arrays in themodules463 !! ** Purpose : Allocate all the dynamic arrays of the OPA modules 465 464 !! 466 465 !! ** Method : 467 !!468 !! History :469 !! 9.0 ! 01-11 (A. R. Porter, STFC Daresbury)470 466 !!---------------------------------------------------------------------- 471 #if defined key_lim2472 USE dom_ice_2, ONLY: dom_ice_alloc_2473 USE ice_2, ONLY: ice_alloc_2474 USE limdia_2, ONLY: lim_dia_alloc_2475 USE limhdf_2, ONLY: lim_hdf_alloc_2476 USE limsbc_2, ONLY: lim_sbc_alloc_2477 USE limwri_2, ONLY: lim_wri_alloc_2478 USE thd_ice_2, ONLY: thd_ice_alloc_2479 #endif480 #if defined key_lim3 || ( defined key_lim2 && ! defined key_lim2_vp )481 USE limrhg, ONLY: lim_rhg_alloc482 #endif483 #if defined key_lim3484 USE dom_ice, ONLY: dom_ice_alloc485 USE limitd_me, ONLY: lim_itd_me_alloc486 USE thd_ice, ONLY: thd_ice_alloc487 #endif488 #if defined key_bdy489 USE bdy_oce, ONLY: bdy_oce_alloc490 #endif491 #if defined key_diaar5492 USE diaar5, ONLY: dia_ar5_alloc493 #endif494 # if defined key_dimgout495 USE diadimg, ONLY: dia_wri_dimg_alloc496 #endif497 467 #if defined key_diahth || defined key_esopa 498 468 USE diahth, ONLY: dia_hth_alloc … … 549 519 USE sbcdcy, ONLY: sbc_dcy_alloc 550 520 USE sbcfwb, ONLY: sbc_fwb_alloc 551 #if defined key_lim3 || defined key_lim2552 USE sbc_ice, ONLY: sbc_ice_alloc553 #endif554 521 USE sbc_oce, ONLY: sbc_oce_alloc 555 522 USE sbcrnf, ONLY: sbc_rnf_alloc … … 575 542 ! TOP-related alloc routines... 576 543 #if defined key_top 577 USE trcadv, ONLY: trc_adv_alloc578 USE trc, ONLY: trc_alloc579 USE trcnxt, ONLY: trc_nxt_alloc580 USE trczdf, ONLY: trc_zdf_alloc581 USE trdmod_trc_oce,ONLY: trd_mod_trc_oce_alloc544 USE trcadv, ONLY: trc_adv_alloc 545 USE trc, ONLY: trc_alloc 546 USE trcnxt, ONLY: trc_nxt_alloc 547 USE trczdf, ONLY: trc_zdf_alloc 548 USE trdmod_trc_oce,ONLY: trd_mod_trc_oce_alloc 582 549 #endif 583 550 #if defined key_top && ! defined key_iomput 584 USE trcdia, ONLY: trc_dia_alloc551 USE trcdia, ONLY: trc_dia_alloc 585 552 #endif 586 553 #if defined key_top && defined key_trcdmp 587 USE trcdmp, ONLY: trc_dmp_alloc554 USE trcdmp, ONLY: trc_dmp_alloc 588 555 #endif 589 556 #if defined key_top && defined key_dtatrc 590 USE trcdta, ONLY: trc_dta_alloc557 USE trcdta, ONLY: trc_dta_alloc 591 558 #endif 592 559 #if defined key_top && ( defined key_trdmld_trc || defined key_esopa ) 593 USE trdmld_trc, ONLY: trd_mld_trc_alloc594 #endif 595 ! ...end of TOP-related alloc routines596 597 ! LOBSTER-related alloc routines...598 USE sms_lobster, ONLY: sms_lobster_alloc599 ! ...end of LOBSTER-related alloc routines600 601 USE trc_oce, ONLY: trc_oce_alloc560 USE trdmld_trc, ONLY: trd_mld_trc_alloc 561 #endif 562 ! ...end of TOP-related alloc routines 563 564 ! LOBSTER-related alloc routines... 565 USE sms_lobster, ONLY: sms_lobster_alloc 566 ! ...end of LOBSTER-related alloc routines 567 568 USE trc_oce, ONLY: trc_oce_alloc 602 569 #if defined key_trdmld || defined key_esopa 603 USE trdmld, ONLY: trd_mld_alloc604 #endif 605 USE trdmld_oce, ONLY: trdmld_oce_alloc570 USE trdmld, ONLY: trd_mld_alloc 571 #endif 572 USE trdmld_oce, ONLY: trdmld_oce_alloc 606 573 #if defined key_trdtra || defined key_trdmld || defined key_trdmld_trc 607 USE trdtra, ONLY: trd_tra_alloc574 USE trdtra, ONLY: trd_tra_alloc 608 575 #endif 609 576 #if defined key_trdvor || defined key_esopa 610 USE trdvor, ONLY: trd_vor_alloc611 #endif 612 USE wrk_nemo, ONLY: wrk_alloc613 USE zdfbfr, ONLY: zdf_bfr_alloc577 USE trdvor, ONLY: trd_vor_alloc 578 #endif 579 USE wrk_nemo, ONLY: wrk_alloc 580 USE zdfbfr, ONLY: zdf_bfr_alloc 614 581 #if defined key_zdfddm || defined key_esopa 615 USE zdfddm, ONLY: zdf_ddm_alloc582 USE zdfddm, ONLY: zdf_ddm_alloc 616 583 #endif 617 584 #if defined key_zdfkpp || defined key_esopa 618 USE zdfkpp, ONLY: zdf_kpp_alloc585 USE zdfkpp, ONLY: zdf_kpp_alloc 619 586 #endif 620 587 #if defined key_zdfgls || defined key_esopa 621 USE zdfgls, ONLY: zdf_gls_alloc622 #endif 623 USE zdfmxl, ONLY: zdf_mxl_alloc624 USE zdf_oce, ONLY: zdf_oce_alloc588 USE zdfgls, ONLY: zdf_gls_alloc 589 #endif 590 USE zdfmxl, ONLY: zdf_mxl_alloc 591 USE zdf_oce, ONLY: zdf_oce_alloc 625 592 #if defined key_zdfric || defined key_esopa 626 USE zdfric, ONLY: zdf_ric_alloc593 USE zdfric, ONLY: zdf_ric_alloc 627 594 #endif 628 595 #if defined key_zdftke || defined key_esopa 629 USE zdftke, ONLY: zdf_tke_alloc596 USE zdftke, ONLY: zdf_tke_alloc 630 597 #endif 631 598 #if defined key_zdftmx 632 USE zdftmx, ONLY: zdf_tmx_alloc 633 #endif 634 IMPLICIT none 635 INTEGER :: ierr 636 INTEGER :: i 637 !!---------------------------------------------------------------------- 638 639 ierr = 0 640 641 !! Calls to the _alloc() routines should be in the same order as the 642 !! modules are USE'd above 643 #if defined key_lim2 644 ierr = ierr + dom_ice_alloc_2() 645 ierr = ierr + ice_alloc_2() 646 ierr = ierr + lim_dia_alloc_2() 647 ierr = ierr + lim_hdf_alloc_2() 648 ierr = ierr + lim_sbc_alloc_2() 649 ierr = ierr + lim_wri_alloc_2() 650 ierr = ierr + thd_ice_alloc_2() 651 #endif 652 #if defined key_lim3 || ( defined key_lim2 && ! defined key_lim2_vp ) 653 ierr = ierr + lim_rhg_alloc() 654 #endif 655 #if defined key_lim3 656 ierr = ierr + dom_ice_alloc() 657 ierr = ierr + lim_itd_me_alloc() 658 ierr = ierr + thd_ice_alloc() 659 #endif 660 ! End of ice-related allocations 661 #if defined key_bdy 662 ierr = ierr + bdy_oce_alloc() 663 #endif 664 #if defined key_diaar5 665 ierr = ierr + dia_ar5_alloc() 666 #endif 667 # if defined key_dimgout 668 ierr = ierr + dia_wri_dimg_alloc() 669 #endif 670 ierr = ierr + div_cur_alloc() 599 USE zdftmx, ONLY: zdf_tmx_alloc 600 #endif 601 IMPLICIT none 602 INTEGER :: ierr 603 INTEGER :: i 604 !!---------------------------------------------------------------------- 605 606 ierr = 0 607 608 !! Calls to the _alloc() routines should be in the same order as the 609 !! modules are USE'd above 610 ! End of ice-related allocations 611 ierr = ierr + div_cur_alloc() 671 612 #if defined key_diahth || defined key_esopa 672 ierr = ierr + dia_hth_alloc()673 #endif 674 ierr = ierr + dia_ptr_alloc()675 ierr = ierr + dia_wri_alloc()676 ierr = ierr + dom_oce_alloc()613 ierr = ierr + dia_hth_alloc() 614 #endif 615 ierr = ierr + dia_ptr_alloc() 616 ierr = ierr + dia_wri_alloc() 617 ierr = ierr + dom_oce_alloc() 677 618 #if defined key_vvl 678 ierr = ierr + dom_vvl_alloc()679 #endif 680 ierr = ierr + dom_wri_alloc()619 ierr = ierr + dom_vvl_alloc() 620 #endif 621 ierr = ierr + dom_wri_alloc() 681 622 #if defined key_dtasal || defined key_esopa 682 ierr = ierr + dta_sal_alloc()623 ierr = ierr + dta_sal_alloc() 683 624 #endif 684 625 #if defined key_ldfslp || defined key_esopa 685 ierr = ierr + dyn_ldf_bilapg_alloc()626 ierr = ierr + dyn_ldf_bilapg_alloc() 686 627 #endif 687 628 #if defined key_dtasal || defined key_esopa 688 ierr = ierr + dta_sal_alloc()629 ierr = ierr + dta_sal_alloc() 689 630 #endif 690 631 #if defined key_dtatem || defined key_esopa 691 ierr = ierr + dta_tem_alloc()632 ierr = ierr + dta_tem_alloc() 692 633 #endif 693 634 #if defined key_ldfslp || defined key_esopa 694 ierr = ierr + dyn_ldf_iso_alloc()635 ierr = ierr + dyn_ldf_iso_alloc() 695 636 #endif 696 637 #if defined key_dynspg_ts || defined key_vvl || defined key_esopa 697 ierr = ierr + dynspg_oce_alloc()698 #endif 699 ierr = ierr + dyn_vor_alloc()700 ierr = ierr + dyn_zdf_exp_alloc()638 ierr = ierr + dynspg_oce_alloc() 639 #endif 640 ierr = ierr + dyn_vor_alloc() 641 ierr = ierr + dyn_zdf_exp_alloc() 701 642 #if defined key_floats || defined key_esopa 702 ierr = ierr + flo_oce_alloc()643 ierr = ierr + flo_oce_alloc() 703 644 #endif 704 645 #if defined key_floats || defined key_esopa 705 ierr = ierr + flo_wri_alloc()706 #endif 707 ierr = ierr + geo2oce_alloc()708 ierr = ierr + ldfdyn_oce_alloc()646 ierr = ierr + flo_wri_alloc() 647 #endif 648 ierr = ierr + geo2oce_alloc() 649 ierr = ierr + ldfdyn_oce_alloc() 709 650 #if defined key_ldfslp || defined key_esopa 710 651 ierr = ierr + ldf_slp_alloc() 711 652 #endif 712 ierr = ierr + ldftra_oce_alloc()653 ierr = ierr + ldftra_oce_alloc() 713 654 #if defined key_mpp_mpi 714 ierr = ierr + lib_mpp_alloc()655 ierr = ierr + lib_mpp_alloc() 715 656 #endif 716 657 #if defined key_obc 717 ierr = ierr + obc_dta_alloc()718 ierr = ierr + obc_oce_alloc()719 #endif 720 ierr = ierr + oce_alloc()721 ierr = ierr + sbc_blk_clio_alloc()658 ierr = ierr + obc_dta_alloc() 659 ierr = ierr + obc_oce_alloc() 660 #endif 661 ierr = ierr + oce_alloc() 662 ierr = ierr + sbc_blk_clio_alloc() 722 663 #if defined key_oasis3 || defined key_oasis4 723 ierr = ierr + sbc_cpl_init_alloc() 724 #endif 725 ierr = ierr + sbc_dcy_alloc() 726 ierr = ierr + sbc_fwb_alloc() 727 #if defined key_lim3 || defined key_lim2 728 ierr = ierr + sbc_ice_alloc() 729 #endif 730 ierr = ierr + sbc_oce_alloc() 731 ierr = ierr + sbc_rnf_alloc() 732 ierr = ierr + sbc_ssr_alloc() 733 ierr = ierr + sol_oce_alloc() 734 ierr = ierr + sol_mat_alloc() 735 ierr = ierr + tra_adv_alloc() 736 ierr = ierr + tra_adv_cen2_alloc() 737 #if defined key_trabbl || defined key_esopa 738 ierr = ierr + tra_bbl_alloc() 739 #endif 740 #if defined key_tradmp || defined key_esopa 741 ierr = ierr + tra_dmp_alloc() 742 #endif 743 ierr = ierr + tra_ldf_alloc() 744 #if defined key_ldfslp || defined key_esopa 745 ierr = ierr + tra_ldf_iso_grif_alloc() 746 #endif 747 ierr = ierr + tra_ldf_lap_alloc() 748 ierr = ierr + tra_nxt_alloc() 749 ierr = ierr + tra_zdf_alloc() 750 751 ! Start of TOP-related alloc routines... 664 ierr = ierr + sbc_cpl_init_alloc() 665 #endif 666 ierr = ierr + sbc_dcy_alloc() 667 ierr = ierr + sbc_fwb_alloc() 668 ierr = ierr + sbc_oce_alloc() 669 ierr = ierr + sbc_rnf_alloc() 670 ierr = ierr + sbc_ssr_alloc() 671 ierr = ierr + sol_oce_alloc() 672 ierr = ierr + sol_mat_alloc() 673 ierr = ierr + tra_adv_alloc() 674 ierr = ierr + tra_adv_cen2_alloc() 675 #if defined key_trabbl || defined key_esopa 676 ierr = ierr + tra_bbl_alloc() 677 #endif 678 #if defined key_tradmp || defined key_esopa 679 ierr = ierr + tra_dmp_alloc() 680 #endif 681 ierr = ierr + tra_ldf_alloc() 682 #if defined key_ldfslp || defined key_esopa 683 ierr = ierr + tra_ldf_iso_grif_alloc() 684 #endif 685 ierr = ierr + tra_ldf_lap_alloc() 686 ierr = ierr + tra_nxt_alloc() 687 ierr = ierr + tra_zdf_alloc() 688 689 ! Start of TOP-related alloc routines... 752 690 #if defined key_top 753 ierr = ierr + trc_adv_alloc()754 ierr = ierr + trc_alloc()755 ierr = ierr + trc_nxt_alloc()756 ierr = ierr + trc_zdf_alloc()757 ierr = ierr + trd_mod_trc_oce_alloc()691 ierr = ierr + trc_adv_alloc() 692 ierr = ierr + trc_alloc() 693 ierr = ierr + trc_nxt_alloc() 694 ierr = ierr + trc_zdf_alloc() 695 ierr = ierr + trd_mod_trc_oce_alloc() 758 696 #endif 759 697 #if defined key_top && ! defined key_iomput 760 ierr = ierr + trc_dia_alloc()698 ierr = ierr + trc_dia_alloc() 761 699 #endif 762 700 #if defined key_top && defined key_trcdmp 763 ierr = ierr + trc_dmp_alloc()701 ierr = ierr + trc_dmp_alloc() 764 702 #endif 765 703 #if defined key_top && defined key_dtatrc 766 ierr = ierr + trc_dta_alloc()704 ierr = ierr + trc_dta_alloc() 767 705 #endif 768 706 #if defined key_top && ( defined key_trdmld_trc || defined key_esopa ) 769 ierr = ierr + trd_mld_trc_alloc()770 #endif 771 ! ...end of TOP-related alloc routines772 773 ! Start of LOBSTER-related alloc routines774 ierr = ierr + sms_lobster_alloc()775 ! ...end of LOBSTER-related alloc routines776 777 ierr = ierr + trc_oce_alloc()707 ierr = ierr + trd_mld_trc_alloc() 708 #endif 709 ! ...end of TOP-related alloc routines 710 711 ! Start of LOBSTER-related alloc routines 712 ierr = ierr + sms_lobster_alloc() 713 ! ...end of LOBSTER-related alloc routines 714 715 ierr = ierr + trc_oce_alloc() 778 716 #if defined key_trdmld || defined key_esopa 779 ierr = ierr + trd_mld_alloc()780 #endif 781 ierr = ierr + trdmld_oce_alloc()717 ierr = ierr + trd_mld_alloc() 718 #endif 719 ierr = ierr + trdmld_oce_alloc() 782 720 #if defined key_trdtra || defined key_trdmld || defined key_trdmld_trc 783 ierr = ierr + trd_tra_alloc()721 ierr = ierr + trd_tra_alloc() 784 722 #endif 785 723 #if defined key_trdvor || defined key_esopa 786 ierr = ierr + trd_vor_alloc()787 #endif 788 ierr = ierr + wrk_alloc()789 ierr = ierr + zdf_bfr_alloc()724 ierr = ierr + trd_vor_alloc() 725 #endif 726 ierr = ierr + wrk_alloc() 727 ierr = ierr + zdf_bfr_alloc() 790 728 #if defined key_zdfddm || defined key_esopa 791 ierr = ierr + zdf_ddm_alloc()729 ierr = ierr + zdf_ddm_alloc() 792 730 #endif 793 731 #if defined key_zdfkpp || defined key_esopa 794 ierr = ierr + zdf_kpp_alloc()732 ierr = ierr + zdf_kpp_alloc() 795 733 #endif 796 734 #if defined key_zdfgls || defined key_esopa 797 ierr = ierr + zdf_gls_alloc()798 #endif 799 ierr = ierr + zdf_mxl_alloc()800 ierr = ierr + zdf_oce_alloc()735 ierr = ierr + zdf_gls_alloc() 736 #endif 737 ierr = ierr + zdf_mxl_alloc() 738 ierr = ierr + zdf_oce_alloc() 801 739 #if defined key_zdfric || defined key_esopa 802 ierr = ierr + zdf_ric_alloc()740 ierr = ierr + zdf_ric_alloc() 803 741 #endif 804 742 #if defined key_zdftke || defined key_esopa 805 ierr = ierr + zdf_tke_alloc()743 ierr = ierr + zdf_tke_alloc() 806 744 #endif 807 745 #if defined key_zdftmx 808 ierr = ierr + zdf_tmx_alloc() 809 #endif 810 811 IF( lk_mpp ) CALL mpp_sum(ierr) 812 813 IF(ierr > 0)THEN 814 WRITE(numout,*) 815 WRITE(numout,*) 'ERROR: Allocation of memory failed in nemo_alloc' 816 IF( lk_mpp ) CALL mppstop() 817 STOP 818 END IF 819 746 ierr = ierr + zdf_tmx_alloc() 747 #endif 748 749 IF( lk_mpp ) CALL mpp_sum(ierr) 750 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' ) 751 ! 820 752 END SUBROUTINE nemo_alloc 821 753 822 !!====================================================================== 823 824 SUBROUTINE nemo_partition(num_pes) 754 755 SUBROUTINE nemo_partition( num_pes ) 825 756 USE par_oce 826 IMPLICIT none827 757 INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have 828 758 ! Local variables -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90
r2598 r2613 20 20 INTEGER, PARAMETER :: num_2d_wrkspaces = 35 ! No. of 2D workspace arrays (jpi,jpj) 21 21 INTEGER, PARAMETER :: num_3d_wrkspaces = 15 ! No. of 3D workspace arrays (jpi,jpj,jpk) 22 INTEGER, PARAMETER :: num_4d_wrkspaces = 4 ! No. of 4D workspace arrays (jpi,jpj,jpk,jpts)22 INTEGER, PARAMETER :: num_4d_wrkspaces = 4 ! No. of 4D workspace arrays (jpi,jpj,jpk,jpts) 23 23 24 24 INTEGER, PARAMETER :: num_xz_wrkspaces = 4 ! No. of 2D, xz workspace arrays (jpi,jpk)
Note: See TracChangeset
for help on using the changeset viewer.