Changeset 2590
- Timestamp:
- 2011-02-18T13:49:27+01:00 (14 years ago)
- Location:
- branches/dev_r2586_dynamic_mem
- Files:
-
- 3 added
- 138 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90
r2528 r2590 20 20 PRIVATE 21 21 22 ! Routine accessibility 23 PUBLIC dom_ice_alloc_2 ! Called from nemogcm.F90 24 22 25 LOGICAL, PUBLIC :: l_jeq = .TRUE. !: Equator inside the domain flag 23 26 … … 25 28 ! ! (otherwise = jpj+10 (SH) or -10 (SH) ) 26 29 27 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: fs2cor , fcor !: coriolis factor and coeficient28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: covrai !: sine of geographic latitude29 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: area !: surface of grid cell30 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tms , tmu !: temperature and velocity points masks31 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2) :: wght !: weight of the 4 neighbours to compute averages30 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fs2cor , fcor !: coriolis factor and coeficient 31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: covrai !: sine of geographic latitude 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: area !: surface of grid cell 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tms , tmu !: temperature and velocity points masks 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wght !: weight of the 4 neighbours to compute averages 32 35 33 36 34 37 # if defined key_lim2_vp 35 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2) :: akappa , bkappa !: first and third group of metric coefficients36 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2,2,2) :: alambd !: second group of metric coefficients38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: akappa , bkappa !: first and third group of metric coefficients 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:,:) :: alambd !: second group of metric coefficients 37 40 # else 38 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tmv , tmf !: y-velocity and F-points masks39 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tmi !: ice mask: =1 if ice thick > 041 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmv , tmf !: y-velocity and F-points masks 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmi !: ice mask: =1 if ice thick > 0 40 43 # endif 41 44 … … 46 49 #endif 47 50 !!====================================================================== 51 #if defined key_lim2 52 CONTAINS 53 54 FUNCTION dom_ice_alloc_2() 55 USE in_out_manager, ONLY: ctl_warn 56 IMPLICIT none 57 INTEGER :: dom_ice_alloc_2 58 INTEGER :: ierr(2) 59 60 ierr(:) = 0 61 62 ALLOCATE(fs2cor(jpi,jpj), fcor(jpi,jpj), & 63 covrai(jpi,jpj), area(jpi,jpj), tms(jpi,jpj), tmu(jpi,jpj), & 64 wght(jpi,jpj,2,2), Stat=ierr(1) ) 65 66 ALLOCATE( & 67 #if defined key_lim2_vp 68 akappa(jpi,jpj,2,2), bkappa(jpi,jpj,2,2), & 69 alambd(jpi,jpj,2,2,2,2), & 70 #else 71 tmv(jpi,jpj), tmf(jpi,jpj), tmi(jpi,jpj), & 72 #endif 73 Stat=ierr(2)) 74 75 dom_ice_alloc_2 = MAXVAL(ierr) 76 77 IF(dom_ice_alloc_2 /= 0)THEN 78 CALL ctl_warn('dom_ice_alloc_2: failed to allocate arrays.') 79 END IF 80 81 END FUNCTION dom_ice_alloc_2 82 #endif 83 48 84 END MODULE dom_ice_2 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90
r2528 r2590 16 16 PRIVATE 17 17 18 ! Routine accessibility 19 PUBLIC ice_alloc_2 ! Called in nemogcm.F90 20 18 21 INTEGER , PUBLIC :: numit !: ice iteration index 19 22 REAL(wp), PUBLIC :: rdt_ice !: ice time step … … 54 57 REAL(wp), PUBLIC :: pstarh !: pstar / 2.0 55 58 56 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ahiu , ahiv !: hor. diffusivity coeff. at ocean U- and V-points (m2/s)57 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: pahu , pahv !: ice hor. eddy diffusivity coef. at ocean U- and V-points58 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ust2s !: friction velocity59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahiu , ahiv !: hor. diffusivity coeff. at ocean U- and V-points (m2/s) 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pahu , pahv !: ice hor. eddy diffusivity coef. at ocean U- and V-points 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ust2s !: friction velocity 59 62 60 63 !!* Ice Rheology … … 63 66 LOGICAL , PUBLIC :: lk_lim2_vp = .TRUE. !: Visco-Plactic reology flag 64 67 ! 65 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hsnm , hicm !: mean snow and ice thicknesses68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hsnm , hicm !: mean snow and ice thicknesses 66 69 ! 67 70 # else … … 69 72 LOGICAL , PUBLIC:: lk_lim2_vp = .FALSE. !: Visco-Plactic reology flag 70 73 ! 71 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: stress1_i !: first stress tensor element72 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: stress2_i !: second stress tensor element73 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: stress12_i !: diagonal stress tensor element74 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: delta_i !: rheology delta factor (see Flato and Hibler 95) [s-1]75 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: divu_i !: Divergence of the velocity field [s-1] -> limrhg.F9076 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: shear_i !: Shear of the velocity field [s-1] -> limrhg.F9077 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: at_i !: ice fraction74 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: stress1_i !: first stress tensor element 75 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: stress2_i !: second stress tensor element 76 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: stress12_i !: diagonal stress tensor element 77 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: delta_i !: rheology delta factor (see Flato and Hibler 95) [s-1] 78 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: divu_i !: Divergence of the velocity field [s-1] -> limrhg.F90 79 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: shear_i !: Shear of the velocity field [s-1] -> limrhg.F90 80 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i !: ice fraction 78 81 ! 79 82 REAL(wp), PUBLIC, DIMENSION(:,:) , POINTER :: vt_s ,vt_i !: mean snow and ice thicknesses 80 REAL(wp), PUBLIC, DIMENSION(jpi,jpj), TARGET :: hsnm , hicm !: target vt_s,vt_i pointers81 #endif 82 83 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: rdvosif !: ice volume change at ice surface (only used for outputs)84 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: rdvobif !: ice volume change at ice bottom (only used for outputs)85 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: fdvolif !: Total ice volume change (only used for outputs)86 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: rdvonif !: Lateral ice volume change (only used for outputs)87 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sist !: Sea-Ice Surface Temperature [Kelvin]88 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tfu !: Freezing/Melting point temperature of sea water at SSS89 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hicif !: Ice thickness90 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hsnif !: Snow thickness91 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hicifp !: Ice production/melting92 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: frld !: Leads fraction = 1-a/totalarea93 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: phicif !: ice thickness at previous time94 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: pfrld !: Leads fraction at previous time95 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: qstoif !: Energy stored in the brine pockets96 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: fbif !: Heat flux at the ice base97 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: rdmsnif !: Variation of snow mass98 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: rdmicif !: Variation of ice mass99 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: qldif !: heat balance of the lead (or of the open ocean)100 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: qcmif !: Energy needed to freeze the ocean surface layer101 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: fdtcn !: net downward heat flux from the ice to the ocean102 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: qdtcn !: energy from the ice to the ocean point (at a factor 2)103 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: thcm !: part of the solar energy used in the lead heat budget104 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: fstric !: Solar flux transmitted trough the ice105 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ffltbif !: linked with the max heat contained in brine pockets (?)106 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: fscmbq !: Linked with the solar flux below the ice (?)107 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: fsbbq !: Also linked with the solar flux below the ice (?)108 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: qfvbq !: used to store energy in case of toral lateral ablation (?)109 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: dmgwi !: Variation of the mass of snow ice110 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: u_ice, v_ice !: two components of the ice velocity at I-point (m/s)111 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: u_oce, v_oce !: two components of the ocean velocity at I-point (m/s)112 113 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jplayersp1) :: tbif !: Temperature inside the ice/snow layer83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: hsnm , hicm !: target vt_s,vt_i pointers 84 #endif 85 86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdvosif !: ice volume change at ice surface (only used for outputs) 87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdvobif !: ice volume change at ice bottom (only used for outputs) 88 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fdvolif !: Total ice volume change (only used for outputs) 89 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdvonif !: Lateral ice volume change (only used for outputs) 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sist !: Sea-Ice Surface Temperature [Kelvin] 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tfu !: Freezing/Melting point temperature of sea water at SSS 92 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hicif !: Ice thickness 93 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hsnif !: Snow thickness 94 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hicifp !: Ice production/melting 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: frld !: Leads fraction = 1-a/totalarea 96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: phicif !: ice thickness at previous time 97 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pfrld !: Leads fraction at previous time 98 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qstoif !: Energy stored in the brine pockets 99 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fbif !: Heat flux at the ice base 100 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdmsnif !: Variation of snow mass 101 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdmicif !: Variation of ice mass 102 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qldif !: heat balance of the lead (or of the open ocean) 103 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qcmif !: Energy needed to freeze the ocean surface layer 104 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fdtcn !: net downward heat flux from the ice to the ocean 105 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qdtcn !: energy from the ice to the ocean point (at a factor 2) 106 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: thcm !: part of the solar energy used in the lead heat budget 107 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fstric !: Solar flux transmitted trough the ice 108 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ffltbif !: linked with the max heat contained in brine pockets (?) 109 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fscmbq !: Linked with the solar flux below the ice (?) 110 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsbbq !: Also linked with the solar flux below the ice (?) 111 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qfvbq !: used to store energy in case of toral lateral ablation (?) 112 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dmgwi !: Variation of the mass of snow ice 113 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice !: two components of the ice velocity at I-point (m/s) 114 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce, v_oce !: two components of the ocean velocity at I-point (m/s) 115 116 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tbif !: Temperature inside the ice/snow layer 114 117 115 118 !!* moment used in the advection scheme 116 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sxice, syice, sxxice, syyice, sxyice !: for ice volume117 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sxsn, sysn, sxxsn, syysn, sxysn !: for snow volume118 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sxa, sya, sxxa, syya, sxya !: for ice cover area119 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sxc0, syc0, sxxc0, syyc0, sxyc0 !: for heat content of snow120 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sxc1, syc1, sxxc1, syyc1, sxyc1 !: for heat content of 1st ice layer121 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sxc2, syc2, sxxc2, syyc2, sxyc2 !: for heat content of 2nd ice layer122 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sxst, syst, sxxst, syyst, sxyst !: for heat content of brine pockets119 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sxice, syice, sxxice, syyice, sxyice !: for ice volume 120 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sxsn, sysn, sxxsn, syysn, sxysn !: for snow volume 121 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sxa, sya, sxxa, syya, sxya !: for ice cover area 122 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sxc0, syc0, sxxc0, syyc0, sxyc0 !: for heat content of snow 123 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sxc1, syc1, sxxc1, syyc1, sxyc1 !: for heat content of 1st ice layer 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sxc2, syc2, sxxc2, syyc2, sxyc2 !: for heat content of 2nd ice layer 125 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sxst, syst, sxxst, syyst, sxyst !: for heat content of brine pockets 123 126 124 127 #else … … 133 136 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 134 137 !!====================================================================== 138 139 #if defined key_lim2 140 CONTAINS 141 142 FUNCTION ice_alloc_2() 143 !!----------------------------------------------------------------- 144 !! *** Routine ice_alloc_2 *** 145 !!----------------------------------------------------------------- 146 USE in_out_manager, ONLY: ctl_warn 147 IMPLICIT none 148 INTEGER :: ice_alloc_2 149 ! Local variables 150 INTEGER :: ierr(9) 151 !!----------------------------------------------------------------- 152 153 ierr(:) = 0 154 155 ! What could be one huge allocate statement is broken-up to try to 156 ! 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_vp 163 hsnm(jpi,jpj), hicm(jpi,jpj), & 164 #else 165 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 #endif 169 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)THEN 209 CALL ctl_warn('ice_alloc_2: failed to allocate arrays.') 210 END IF 211 212 END FUNCTION ice_alloc_2 213 214 #endif 215 135 216 END MODULE ice_2 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90
r2528 r2590 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 66 REAL(wp) , INTENT(in ) :: pdf ! reduction factor for the time step 61 67 REAL(wp) , INTENT(in ) :: pcrh ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0) … … 70 76 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 71 77 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - 72 REAL(wp), DIMENSION(jpi,jpj) :: zf0, zfx , zfy , zbet ! 2D workspace73 REAL(wp), DIMENSION(jpi,jpj) :: zfm, zfxx, zfyy, zfxy ! - -74 REAL(wp), DIMENSION(jpi,jpj) :: zalg, zalg1, zalg1q ! - -75 78 !--------------------------------------------------------------------- 79 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 83 END IF 76 84 77 85 ! Limitation of moments. … … 218 226 ENDIF 219 227 ! 228 IF(.NOT. wrk_release(2, 11,12,13,14,15,16,17,18,19,20,21))THEN 229 CALL ctl_stop('lim_adv_x_2 : failed to release workspace arrays.') 230 END IF 231 ! 220 232 END SUBROUTINE lim_adv_x_2 221 233 … … 235 247 !! Reference: Prather, 1986, JGR, 91, D6. 6671-6681. 236 248 !!--------------------------------------------------------------------- 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 254 !! 237 255 REAL(wp) , INTENT(in ) :: pdf ! reduction factor for the time step 238 256 REAL(wp) , INTENT(in ) :: pcrh ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0) … … 247 265 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 248 266 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - 249 REAL(wp), DIMENSION(jpi,jpj) :: zf0, zfx , zfy , zbet ! 2D workspace250 REAL(wp), DIMENSION(jpi,jpj) :: zfm, zfxx, zfyy, zfxy ! - -251 REAL(wp), DIMENSION(jpi,jpj) :: zalg, zalg1, zalg1q ! - -252 267 !--------------------------------------------------------------------- 268 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 272 END IF 253 273 254 274 ! Limitation of moments. … … 398 418 ENDIF 399 419 ! 420 IF(.NOT. wrk_release(2, 11,12,13,14,15,16,17,18,19,20,21))THEN 421 CALL ctl_stop('lim_adv_y_2 : failed to release workspace arrays.') 422 END IF 423 ! 400 424 END SUBROUTINE lim_adv_y_2 401 425 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90
r2528 r2590 29 29 30 30 PUBLIC lim_dia_2 ! called by sbc_ice_lim_2 31 PUBLIC lim_dia_alloc_2 ! called by nemogcm 32 31 33 INTEGER, PUBLIC :: ntmoy = 1 , & !: instantaneous values of ice evolution or averaging ntmoy 32 34 & ninfo = 1 !: frequency of ouputs on file ice_evolu in case of averaging … … 52 54 REAL(wp) :: epsi06 = 1.e-06 ! ??? 53 55 REAL(wp), DIMENSION(jpinfmx) :: vinfom ! temporary working space 54 REAL(wp), DIMENSION(jpi,jpj) :: aire ! masked grid cell area56 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: aire ! masked grid cell area 55 57 56 58 !! * Substitutions … … 63 65 64 66 CONTAINS 67 68 FUNCTION lim_dia_alloc_2() 69 !!-------------------------------------------------------------------- 70 !! *** ROUTINE lim_dia_2 *** 71 !!-------------------------------------------------------------------- 72 IMPLICIT none 73 INTEGER :: lim_dia_alloc_2 74 !!-------------------------------------------------------------------- 75 76 ALLOCATE(aire(jpi,jpj), Stat=lim_dia_alloc_2) 77 78 IF(lim_dia_alloc_2 /= 0)THEN 79 CALL ctl_warn('lim_dia_alloc_2: failed to allocate array aire.') 80 END IF 81 82 END FUNCTION lim_dia_alloc_2 83 65 84 66 85 SUBROUTINE lim_dia_2( kt ) -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90
r2528 r2590 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 63 INTEGER, INTENT(in) :: kt ! number of iteration 61 64 !! … … 63 66 INTEGER :: i_j1, i_jpj ! Starting/ending j-indices for rheology 64 67 REAL(wp) :: zcoef ! temporary scalar 65 REAL(wp), DIMENSION(jpj) :: zind ! i-averaged indicator of sea-ice 66 REAL(wp), DIMENSION(jpj) :: zmsk ! i-averaged of tmask 67 REAL(wp), DIMENSION(jpi,jpj) :: zu_io, zv_io ! ice-ocean velocity 68 REAL(wp), POINTER, DIMENSION(:) :: zind ! i-averaged indicator of sea-ice 69 REAL(wp), POINTER, DIMENSION(:) :: zmsk ! i-averaged of tmask 68 70 !!--------------------------------------------------------------------- 71 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 75 END IF 76 ! Set-up pointers to sub-arrays of workspaces 77 zind => wrk_1d_1(1:jpj) 78 zmsk => wrk_1d_2(1:jpj) 69 79 70 80 IF( kt == nit000 ) CALL lim_dyn_init_2 ! Initialization (first time-step only) … … 200 210 ! 201 211 IF(ln_ctl) CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn : ust2s :') 212 ! 213 IF( (.NOT. wrk_release(1, 1,2)) .OR. (.NOT. wrk_release(2, 1,2)) )THEN 214 CALL ctl_stop('lim_dyn_2 : failed to release workspace arrays.') 215 END IF 202 216 ! 203 217 END SUBROUTINE lim_dyn_2 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90
r2528 r2590 22 22 23 23 !! * Routine accessibility 24 PUBLIC lim_hdf_2 ! called by lim_tra_2 24 PUBLIC lim_hdf_2 ! called by lim_tra_2 25 PUBLIC lim_hdf_alloc_2 ! called by nemogcm 25 26 26 27 !! * Module variables 27 28 LOGICAL :: linit = .TRUE. ! ??? 28 29 REAL(wp) :: epsi04 = 1e-04 ! constant 29 REAL(wp), DIMENSION(jpi,jpj) :: zfact ! ???30 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfact ! ??? 30 31 31 32 !! * Substitution … … 38 39 39 40 CONTAINS 41 42 FUNCTION lim_hdf_alloc_2() 43 !!------------------------------------------------------------------- 44 !! *** ROUTINE lim_hdf_alloc_2 *** 45 !!------------------------------------------------------------------- 46 IMPLICIT none 47 INTEGER :: lim_hdf_alloc_2 48 !!------------------------------------------------------------------- 49 50 ALLOCATE(zfact(jpi,jpj), Stat=lim_hdf_alloc_2) 51 52 IF(lim_hdf_alloc_2 /= 0)THEN 53 CALL ctl_warn('lim_hdf_alloc_2: failed to allocate zfact array.') 54 END IF 55 56 END FUNCTION lim_hdf_alloc_2 57 40 58 41 59 SUBROUTINE lim_hdf_2( ptab ) … … 56 74 !! ! 02-08 (C. Ethe) F90, free form 57 75 !!------------------------------------------------------------------- 76 USE wrk_nemo, ONLY: wrk_use, wrk_release 77 USE wrk_nemo, ONLY: zrlx => wrk_2d_11, zflu => wrk_2d_12 78 USE wrk_nemo, ONLY: zflv => wrk_2d_13, ptab0 => wrk_2d_14 79 USE wrk_nemo, ONLY: zdiv0 => wrk_2d_15, zdiv => wrk_2d_16 80 !! 58 81 ! * Arguments 59 82 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: & 60 83 ptab ! Field on which the diffusion is applied 61 REAL(wp), DIMENSION(jpi,jpj) :: &62 ptab0 ! ???63 84 64 85 ! * Local variables … … 69 90 REAL(wp) :: & 70 91 zalfa, zrlxint, zconv, zeps ! temporary scalars 71 REAL(wp), DIMENSION(jpi,jpj) :: & 72 zrlx, zflu, zflv, & ! temporary workspaces 73 zdiv0, zdiv ! " " 74 !!------------------------------------------------------------------- 92 !!------------------------------------------------------------------- 93 94 IF(.NOT. wrk_use(2, 11,12,13,14,15,16))THEN 95 CALL ctl_stop('lim_hdf_2 : requested workspace arrays unavailable.') 96 RETURN 97 END IF 75 98 76 99 ! Initialisation … … 170 193 ENDIF 171 194 195 IF(.NOT. wrk_release(2, 11,12,13,14,15,16))THEN 196 CALL ctl_stop('lim_hdf_2 : failed to release workspace arrays.') 197 RETURN 198 END IF 199 172 200 END SUBROUTINE lim_hdf_2 173 201 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90
r2528 r2590 45 45 !! ** Refer. : Deleersnijder et al. Ocean Modelling 100, 7-10 46 46 !!--------------------------------------------------------------------- 47 USE wrk_nemo, ONLY: wrk_use, wrk_release 48 USE wrk_nemo, ONLY: zd2d1 => wrk_2d_1, zd1d2 => wrk_2d_2 47 49 INTEGER :: ji, jj ! dummy loop indices 48 50 REAL(wp) :: zusden ! local scalars … … 51 53 REAL(wp) :: zh1p , zh2p ! - - 52 54 REAL(wp) :: zd2d1p, zd1d2p ! - - 53 REAL(wp), DIMENSION(jpi,jpj) :: zd2d1 , zd1d2 ! 2D workspace54 55 #endif 55 56 !!--------------------------------------------------------------------- 57 58 IF(.NOT. wrk_use(2, 1,2))THEN 59 CALL ctl_stop('lim_msh_2 : requested workspace arrays unavailable.') 60 RETURN 61 END IF 56 62 57 63 IF(lwp) THEN … … 275 281 area(:,:) = e1t(:,:) * e2t(:,:) 276 282 ! 283 IF(.NOT. wrk_release(2, 1,2))THEN 284 CALL ctl_stop('lim_msh_2 : failed to release workspace arrays.') 285 END IF 286 ! 277 287 END SUBROUTINE lim_msh_2 278 288 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90
r2528 r2590 33 33 PRIVATE 34 34 35 PUBLIC lim_rhg_2 ! routine called by lim_dyn 35 PUBLIC lim_rhg_2 ! routine called by lim_dyn 36 PUBLIC lim_rhg_alloc_2 ! routine called by lim_dyn_alloc_2 36 37 37 38 REAL(wp) :: rzero = 0._wp ! constant value: zero 38 39 REAL(wp) :: rone = 1._wp ! and one 40 41 ! 2D workspaces for lim_rhg_2. Can't use wrk_nemo module for them because 42 ! extent in 2nd dimension is > jpj. 43 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: zu0, zv0 44 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: zu_n, zv_n 45 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: zu_a, zv_a 46 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: zviszeta, zviseta 47 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: zzfrld, zztms 48 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: zi1, zi2, zmasst, zpresh 39 49 40 50 !! * Substitutions … … 46 56 !!---------------------------------------------------------------------- 47 57 CONTAINS 58 59 FUNCTION lim_rhg_alloc_2() 60 !!------------------------------------------------------------------- 61 !! *** FUNCTION lim_rhg_alloc_2 *** 62 !!------------------------------------------------------------------- 63 INTEGER :: lim_rhg_alloc_2 64 !!------------------------------------------------------------------- 65 66 ALLOCATE(zu0(jpi,0:jpj+1), zv0(jpi,0:jpj+1), & 67 zu_n(jpi,0:jpj+1), zv_n(jpi,0:jpj+1), & 68 zu_a(jpi,0:jpj+1), zv_a(jpi,0:jpj+1), & 69 zviszeta(jpi,0:jpj+1), zviseta(jpi,0:jpj+1), & 70 zzfrld(jpi,0:jpj+1), zztms(jpi,0:jpj+1), & 71 zi1(jpi,0:jpj+1), zi2(jpi,0:jpj+1), & 72 zmasst(jpi,0:jpj+1), zpresh(jpi,0:jpj+1), & 73 Stat=lim_rhg_alloc_2) 74 75 IF(lim_rhg_alloc_2 /= 0)THEN 76 CALL ctl_warn('lim_rhg_alloc_2 : failed to allocate arrays.') 77 END IF 78 79 END FUNCTION lim_rhg_alloc_2 80 48 81 49 82 SUBROUTINE lim_rhg_2( k_j1, k_jpj ) … … 59 92 !! at I-point 60 93 !!------------------------------------------------------------------- 94 USE wrk_nemo, ONLY: wrk_use, wrk_release 95 USE wrk_nemo, ONLY: zfrld => wrk_2d_1, zmass => wrk_2d_2, zcorl => wrk_2d_3 96 USE wrk_nemo, ONLY: za1ct => wrk_2d_4, za2ct => wrk_2d_5, zresr => wrk_2d_6 97 USE wrk_nemo, ONLY: zc1u => wrk_2d_7, zc1v => wrk_2d_8, zc2u => wrk_2d_9 98 USE wrk_nemo, ONLY: zc2v => wrk_2d_10, zsang => wrk_2d_11 99 !! 61 100 INTEGER, INTENT(in) :: k_j1 ! southern j-index for ice computation 62 101 INTEGER, INTENT(in) :: k_jpj ! northern j-index for ice computation … … 79 118 REAL(wp) :: zs21_11, zs21_12, zs21_21, zs21_22 80 119 REAL(wp) :: zs22_11, zs22_12, zs22_21, zs22_22 81 REAL(wp), DIMENSION(jpi, jpj ) :: zfrld, zmass, zcorl82 REAL(wp), DIMENSION(jpi, jpj ) :: za1ct, za2ct, zresr83 REAL(wp), DIMENSION(jpi, jpj ) :: zc1u, zc1v, zc2u, zc2v84 REAL(wp), DIMENSION(jpi, jpj ) :: zsang85 REAL(wp), DIMENSION(jpi,0:jpj+1) :: zu0, zv086 REAL(wp), DIMENSION(jpi,0:jpj+1) :: zu_n, zv_n87 REAL(wp), DIMENSION(jpi,0:jpj+1) :: zu_a, zv_a88 REAL(wp), DIMENSION(jpi,0:jpj+1) :: zviszeta, zviseta89 REAL(wp), DIMENSION(jpi,0:jpj+1) :: zzfrld, zztms90 REAL(wp), DIMENSION(jpi,0:jpj+1) :: zi1, zi2, zmasst, zpresh91 120 !!------------------------------------------------------------------- 92 121 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r2566 r2590 36 36 PRIVATE 37 37 38 PUBLIC lim_sbc_flx_2 ! called by sbc_ice_lim_2 39 PUBLIC lim_sbc_tau_2 ! called by sbc_ice_lim_2 38 PUBLIC lim_sbc_flx_2 ! called by sbc_ice_lim_2 39 PUBLIC lim_sbc_tau_2 ! called by sbc_ice_lim_2 40 PUBLIC lim_sbc_alloc_2 ! called by nemogcm.F90 40 41 41 42 REAL(wp) :: r1_rdtice ! = 1. / rdt_ice … … 44 45 REAL(wp) :: rone = 1._wp ! - - 45 46 ! 46 REAL(wp), DIMENSION(jpi,jpj) :: soce_0, sice_0 ! constant SSS and ice salinity used in levitating sea-ice case47 48 REAL(wp), DIMENSION(jpi,jpj) :: utau_oce, vtau_oce ! air-ocean surface i- & j-stress [N/m2]49 REAL(wp), DIMENSION(jpi,jpj) :: tmod_io ! modulus of the ice-ocean relative velocity [m/s]47 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: soce_0, sice_0 ! constant SSS and ice salinity used in levitating sea-ice case 48 49 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_oce, vtau_oce ! air-ocean surface i- & j-stress [N/m2] 50 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmod_io ! modulus of the ice-ocean relative velocity [m/s] 50 51 51 52 !! * Substitutions … … 57 58 !!---------------------------------------------------------------------- 58 59 CONTAINS 60 61 FUNCTION lim_sbc_alloc_2() 62 !!------------------------------------------------------------------- 63 !! *** ROUTINE lim_sbc_alloc_2 *** 64 !!------------------------------------------------------------------- 65 IMPLICIT none 66 INTEGER :: lim_sbc_alloc_2 67 !!------------------------------------------------------------------- 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 78 END FUNCTION lim_sbc_alloc_2 79 59 80 60 81 SUBROUTINE lim_sbc_flx_2( kt ) … … 82 103 !! Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 83 104 !!--------------------------------------------------------------------- 105 USE wrk_nemo, ONLY: wrk_release, wrk_use 106 USE wrk_nemo, ONLY: zqnsoce => wrk_2d_1 ! 2D workspace 107 USE wrk_nemo, ONLY: wrk_3d_4, wrk_3d_5 84 108 INTEGER, INTENT(in) :: kt ! number of iteration 85 109 !! … … 90 114 REAL(wp) :: zqsr, zqns, zfm ! local scalars 91 115 REAL(wp) :: zinda, zfons, zemp ! - - 92 REAL(wp), DIMENSION(jpi,jpj) :: zqnsoce ! 2D workspace 93 REAL(wp), DIMENSION(jpi,jpj,1) :: zalb, zalbp ! 2D/3D workspace 116 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 94 117 !!--------------------------------------------------------------------- 95 118 119 IF( (.NOT. wrk_use(2, 1)) .OR. (.NOT. wrk_use(3, 4,5)) )THEN 120 CALL ctl_stop('lim_sbc_flx_2 : requested workspace arrays unavailable.') 121 RETURN 122 END IF 123 ! Set-up pointers to sub-arrays of 3d workspaces 124 zalb => wrk_3d_4(:,:,1:1) 125 zalbp => wrk_3d_5(:,:,1:1) 126 96 127 IF( kt == nit000 ) THEN 97 128 IF(lwp) WRITE(numout,*) … … 150 181 !!$! -> ice aera increases ??? -> ice aera decreases ??? 151 182 !!$ 152 !!$ iadv = ( 1 - i1mfr ) * zinda 183 !!$ iadv = ( 1 - i1mfr ) * zinda 153 184 !!$! pure ocean ice at 154 185 !!$! at current previous … … 159 190 !!$! current 160 191 !!$! -> ??? 161 !!$ 162 !!$ ifrdv = ( 1 - ifral * ( 1 - ial ) ) * iadv 163 !!$! ice disapear 192 !!$ 193 !!$ ifrdv = ( 1 - ifral * ( 1 - ial ) ) * iadv 194 !!$! ice disapear 164 195 !!$ 165 196 !!$ … … 244 275 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' lim_sbc: fr_i : ', tab2d_2=tn_ice(:,:,1), clinfo2=' tn_ice : ') 245 276 ENDIF 277 ! 278 IF( (.NOT. wrk_release(2, 1)) .OR. (.NOT. wrk_release(3, 4,5)) )THEN 279 CALL ctl_stop('lim_sbc_flx_2 : failed to release workspace arrays.') 280 END IF 246 281 ! 247 282 END SUBROUTINE lim_sbc_flx_2 … … 274 309 !! - taum : modulus of the surface ocean stress (T-point) updated with ice-ocean fluxes 275 310 !!--------------------------------------------------------------------- 311 USE wrk_nemo, ONLY: wrk_use, wrk_release 312 USE wrk_nemo, ONLY: ztio_u => wrk_2d_1, ztio_v => wrk_2d_2 ! ocean stress below sea-ice 276 313 INTEGER , INTENT(in) :: kt ! ocean time-step index 277 314 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pu_oce, pv_oce ! surface ocean currents … … 281 318 REAL(wp) :: zfrldv, zat_v, zv_i, zvtau_ice, zv_t, zmodi ! - - 282 319 REAL(wp) :: zsang, zumt ! - - 283 REAL(wp), DIMENSION(jpi,jpj) :: ztio_u, ztio_v ! ocean stress below sea-ice284 320 !!--------------------------------------------------------------------- 321 ! 322 IF(.NOT. wrk_use(2, 1,2))THEN 323 CALL ctl_stop('lim_sbc_tau_2 : requested workspace arrays unavailable.') 324 RETURN 325 END IF 285 326 ! 286 327 IF( kt == nit000 .AND. lwp ) THEN ! control print … … 405 446 & tab2d_2=vtau, clinfo2=' vtau : ' , mask2=vmask ) 406 447 ! 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 407 452 END SUBROUTINE lim_sbc_tau_2 408 453 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
r2528 r2590 75 75 !! References : Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 76 76 !!--------------------------------------------------------------------- 77 USE wrk_nemo, ONLY: wrk_use, wrk_release 78 USE wrk_nemo, ONLY: ztmp => wrk_2d_1, & ! 2D workspace 79 zqlbsbq => wrk_2d_2, & ! link with lead energy budget qldif 80 zlicegr => wrk_2d_3 ! link with lateral ice growth 81 USE wrk_nemo, ONLY: zmsk => wrk_3d_4 ! 3D workspace 82 USE wrk_nemo, ONLY: zdvosif => wrk_2d_4, & !: Variation of volume at surface 83 zdvobif => wrk_2d_5, & !: Variation of ice volume at the bottom ice (outputs only) 84 zdvolif => wrk_2d_6, & !: Total variation of ice volume (outputs only) 85 zdvonif => wrk_2d_7, & !: Surface accretion Snow to Ice transformation (outputs only) 86 zdvomif => wrk_2d_8, & !: Bottom variation of ice volume due to melting (outputs only) 87 zu_imasstr =>wrk_2d_9, & !: Sea-ice transport along i-axis at U-point (outputs only) 88 zv_imasstr =>wrk_2d_10 !: Sea-ice transport along j-axis at V-point (outputs only) 89 !! 77 90 INTEGER, INTENT(in) :: kt ! number of iteration 78 91 !! … … 91 104 REAL(wp) :: zfontn ! heat flux from snow thickness 92 105 REAL(wp) :: zfntlat, zpareff ! test. the val. of lead heat budget 93 REAL(wp), DIMENSION(jpi,jpj) :: ztmp ! 2D workspace 94 REAL(wp), DIMENSION(jpi,jpj) :: zqlbsbq ! link with lead energy budget qldif 106 95 107 REAL(wp) :: zuice_m, zvice_m ! Sea-ice velocities at U & V-points 96 108 REAL(wp) :: zhice_u, zhice_v ! Sea-ice volume at U & V-points … … 98 110 REAL(wp) :: zrhoij, zrhoijm1 ! temporary scalars 99 111 REAL(wp) :: zztmp ! temporary scalars within a loop 100 REAL(wp), DIMENSION(jpi,jpj) :: zlicegr ! link with lateral ice growth101 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmsk ! 3D workspace102 112 !!$ REAL(wp), DIMENSION(jpi,jpj) :: firic !: IR flux over the ice (outputs only) 103 113 !!$ REAL(wp), DIMENSION(jpi,jpj) :: fcsic !: Sensible heat flux over the ice (outputs only) 104 114 !!$ REAL(wp), DIMENSION(jpi,jpj) :: fleic !: Latent heat flux over the ice (outputs only) 105 115 !!$ REAL(wp), DIMENSION(jpi,jpj) :: qlatic !: latent flux (outputs only) 106 REAL(wp), DIMENSION(jpi,jpj) :: zdvosif !: Variation of volume at surface (outputs only)107 REAL(wp), DIMENSION(jpi,jpj) :: zdvobif !: Variation of ice volume at the bottom ice (outputs only)108 REAL(wp), DIMENSION(jpi,jpj) :: zdvolif !: Total variation of ice volume (outputs only)109 REAL(wp), DIMENSION(jpi,jpj) :: zdvonif !: Surface accretion Snow to Ice transformation (outputs only)110 REAL(wp), DIMENSION(jpi,jpj) :: zdvomif !: Bottom variation of ice volume due to melting (outputs only)111 REAL(wp), DIMENSION(jpi,jpj) :: zu_imasstr !: Sea-ice transport along i-axis at U-point (outputs only)112 REAL(wp), DIMENSION(jpi,jpj) :: zv_imasstr !: Sea-ice transport along j-axis at V-point (outputs only)113 116 !!------------------------------------------------------------------- 117 118 IF( (.NOT. wrk_use(2, 1,2,3,4,5,6,7,8,9,10)) .OR. & 119 (.NOT. wrk_use(3, 4)) ) THEN 120 CALL ctl_stop('lim_thd_2 : requested workspace arrays unavailable') 121 RETURN 122 END IF 114 123 115 124 IF( kt == nit000 ) CALL lim_thd_init_2 ! Initialization (first time-step only) … … 512 521 ENDIF 513 522 ! 523 IF( (.NOT. wrk_release(2, 1,2,3,4,5,6,7,8,9,10)) .OR. & 524 (.NOT. wrk_release(3, 4)) ) THEN 525 CALL ctl_stop('lim_thd_2 : failed to release workspace arrays') 526 END IF 527 ! 514 528 END SUBROUTINE lim_thd_2 515 529 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90
r2528 r2590 68 68 !! 2.0 ! 02-08 (C. Ethe, G. Madec) F90, mpp 69 69 !!------------------------------------------------------------------- 70 USE wrk_nemo, ONLY: wrk_use, wrk_release 71 USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_2, wrk_1d_3, wrk_1d_4, wrk_1d_5, wrk_1d_6 72 USE in_out_manager, ONLY: ctl_stop 73 !! 70 74 !! * Arguments 71 75 INTEGER , INTENT(IN):: & … … 79 83 iiceform , & ! 1 = ice formed ; 0 = no ice formed 80 84 ihemis ! dummy indice 81 REAL(wp), DIMENSION(jpij) :: &85 REAL(wp), POINTER, DIMENSION(:) :: & 82 86 zqbgow , & ! heat budget of the open water (negative) 83 87 zfrl_old , & ! previous sea/ice fraction … … 101 105 zah, zalpha , zbeta 102 106 !!--------------------------------------------------------------------- 103 107 108 IF(.NOT. wrk_use(1, 1,2,3,4,5,6))THEN 109 CALL ctl_stop('lim_thd_lac_2 : requestead workspace arrays unavailable.') 110 RETURN 111 END IF 112 ! Set-up pointers to sub-arrays of workspace arrays 113 zqbgow => wrk_1d_1(1:jpij) 114 zfrl_old => wrk_1d_2(1:jpij) 115 zhice_old => wrk_1d_3(1:jpij) 116 zhice0 => wrk_1d_4(1:jpij) 117 zfrlmin => wrk_1d_5(1:jpij) 118 zdhicbot => wrk_1d_6(1:jpij) 119 104 120 !-------------------------------------------------------------- 105 121 ! Computation of the heat budget of the open water (negative) … … 219 235 END DO 220 236 237 IF(.NOT. wrk_release(1, 1,2,3,4,5,6))THEN 238 CALL ctl_stop('lim_thd_lac_2 : failed to release workspace arrays.') 239 END IF 240 221 241 END SUBROUTINE lim_thd_lac_2 222 242 #else -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
r2528 r2590 69 69 !! Fichefet T. and M. Maqueda 1999, Clim. Dyn, 15(4), 251-268 70 70 !!------------------------------------------------------------------ 71 USE wrk_nemo, ONLY: wrk_use, wrk_release 72 USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_2, wrk_1d_3, wrk_1d_4, wrk_1d_5 73 USE wrk_nemo, ONLY: wrk_1d_6, wrk_1d_7, wrk_1d_8, wrk_1d_9, wrk_1d_10 74 USE wrk_nemo, ONLY: wrk_1d_11, wrk_1d_12, wrk_1d_13, wrk_1d_14, wrk_1d_15 75 USE wrk_nemo, ONLY: wrk_1d_16, wrk_1d_17, wrk_1d_18, wrk_1d_19, wrk_1d_20 76 USE wrk_nemo, ONLY: wrk_1d_21, wrk_1d_22, wrk_1d_23, wrk_1d_24, wrk_1d_25 77 USE wrk_nemo, ONLY: wrk_1d_26, wrk_1d_27 78 !! 71 79 INTEGER, INTENT(in) :: kideb ! Start point on which the the computation is applied 72 80 INTEGER, INTENT(in) :: kiut ! End point on which the the computation is applied 73 81 !! 74 82 INTEGER :: ji ! dummy loop indices 75 REAL(wp), DIMENSION(jpij,2) :: zqcmlt ! energy due to surface( /1 ) and bottom melting( /2 ) 76 REAL(wp), DIMENSION(jpij) :: & 83 REAL(wp), POINTER, DIMENSION(:) :: zqcmlts ! energy due to surface melting 84 REAL(wp), POINTER, DIMENSION(:) :: zqcmltb ! energy due to bottom melting 85 REAL(wp), POINTER, DIMENSION(:) :: & 77 86 ztsmlt & ! snow/ice surface melting temperature 78 87 ,ztbif & ! int. temp. at the mid-point of the 1st layer of the snow/ice sys. … … 88 97 , zts_old & ! previous surface temperature 89 98 , zidsn , z1midsn , zidsnic ! tempory variables 90 REAL(wp), DIMENSION(jpij) :: &99 REAL(wp), POINTER, DIMENSION(:) :: & 91 100 zfnet & ! net heat flux at the top surface( incl. conductive heat flux) 92 101 , zsprecip & ! snow accumulation … … 160 169 !!---------------------------------------------------------------------- 161 170 171 IF(.NOT. wrk_use(1, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, & 172 11,12,13,14,15,16,17,18,19,20, & 173 21,22,23,24,25,26,27))THEN 174 CALL ctl_stop('lim_thd_zdf_2 : requested workspace arrays unavailable.') 175 RETURN 176 END IF 177 178 ztsmlt => wrk_1d_1(1:jpij) 179 ztbif => wrk_1d_2(1:jpij) 180 zksn => wrk_1d_3(1:jpij) 181 zkic => wrk_1d_4(1:jpij) 182 zksndh => wrk_1d_5(1:jpij) 183 zfcsu => wrk_1d_6(1:jpij) 184 zfcsudt => wrk_1d_7(1:jpij) 185 zi0 => wrk_1d_8(1:jpij) 186 z1mi0 => wrk_1d_9(1:jpij) 187 zqmax => wrk_1d_10(1:jpij) 188 zrcpdt => wrk_1d_11(1:jpij) 189 zts_old => wrk_1d_12(1:jpij) 190 zidsn => wrk_1d_13(1:jpij) 191 z1midsn => wrk_1d_14(1:jpij) 192 zidsnic => wrk_1d_15(1:jpij) 193 194 zfnet => wrk_1d_16(1:jpij) 195 zsprecip => wrk_1d_17(1:jpij) 196 zhsnw_old => wrk_1d_18(1:jpij) 197 zdhictop => wrk_1d_19(1:jpij) 198 zdhicbot => wrk_1d_20(1:jpij) 199 zqsup => wrk_1d_21(1:jpij) 200 zqocea => wrk_1d_22(1:jpij) 201 zfrl_old => wrk_1d_23(1:jpij) 202 zfrld_1d => wrk_1d_24(1:jpij) 203 zep => wrk_1d_25(1:jpij) 204 205 zqcmlts => wrk_1d_26(1:jpij) 206 zqcmltb => wrk_1d_27(1:jpij) 207 162 208 !----------------------------------------------------------------------- 163 209 ! 1. Boundaries conditions for snow/ice system internal temperature … … 171 217 zihic = MAX( zzero , SIGN( zone , hicdif - h_ice_1d(ji) ) ) 172 218 !--computation of energy due to surface melting 173 zqcmlt (ji,1) = ( MAX ( zzero , &219 zqcmlts(ji) = ( MAX ( zzero , & 174 220 & rcpsn * h_snow_1d(ji) * ( tbif_1d(ji,1) - rt0_snow ) ) ) * ( 1.0 - zihsn ) 175 221 !--computation of energy due to bottom melting 176 zqcmlt (ji,2) = ( MAX( zzero , &222 zqcmltb(ji) = ( MAX( zzero , & 177 223 & rcpic * ( tbif_1d(ji,2) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) & 178 224 & + MAX( zzero , & … … 467 513 zhsnw_old(ji) = h_snow_1d(ji) 468 514 !--computation of the energy needed to melt snow 469 zqsnw_mlt = zfnet(ji) * rdt_ice - zqcmlt (ji,1)515 zqsnw_mlt = zfnet(ji) * rdt_ice - zqcmlts(ji) 470 516 !--change in snow thickness due to melt 471 517 zdhsmlt = - zqsnw_mlt / xlsn … … 587 633 588 634 !---treatment of the case of melting/growing 589 zqice_bot = zibmlt * ( zqice_bot_mlt - zqcmlt (ji,2) ) &590 & + ( 1.0 - zibmlt ) * ( zqice_bot - zqcmlt (ji,2) )635 zqice_bot = zibmlt * ( zqice_bot_mlt - zqcmltb(ji) ) & 636 & + ( 1.0 - zibmlt ) * ( zqice_bot - zqcmltb(ji) ) 591 637 qstbif_1d(ji) = zibmlt * qstbif_1d(ji) & 592 638 & + ( 1.0 - zibmlt ) * zqstbif_bot … … 762 808 END DO 763 809 ! 810 IF(.NOT. wrk_release(1, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, & 811 11,12,13,14,15,16,17,18,19,20, & 812 21,22,23,24,25,26,27))THEN 813 CALL ctl_stop('lim_thd_zdf_2 : failed to release workspace arrays.') 814 END IF 815 ! 764 816 END SUBROUTINE lim_thd_zdf_2 765 817 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90
r2528 r2590 63 63 !! ** action : 64 64 !!--------------------------------------------------------------------- 65 USE wrk_nemo, ONLY: wrk_use, wrk_release 66 USE wrk_nemo, ONLY: zui_u => wrk_2d_1, zvi_v => wrk_2d_2, zsm => wrk_2d_3 67 USE wrk_nemo, ONLY: zs0ice => wrk_2d_4, zs0sn => wrk_2d_5, zs0a => wrk_2d_6 68 USE wrk_nemo, ONLY: zs0c0 => wrk_2d_7, zs0c1 => wrk_2d_8, zs0c2 => wrk_2d_9, & 69 zs0st => wrk_2d_10 70 !! 65 71 INTEGER, INTENT(in) :: kt ! number of iteration 66 72 !! … … 71 77 REAL(wp) :: zvbord , zcfl , zusnit ! - - 72 78 REAL(wp) :: zrtt , ztsn , ztic1 , ztic2 ! - - 73 REAL(wp), DIMENSION(jpi,jpj) :: zui_u , zvi_v , zsm ! 2D workspace74 REAL(wp), DIMENSION(jpi,jpj) :: zs0ice, zs0sn , zs0a ! - -75 REAL(wp), DIMENSION(jpi,jpj) :: zs0c0 , zs0c1 , zs0c2 , zs0st ! - -76 79 !--------------------------------------------------------------------- 80 81 IF(.NOT. wrk_use(2, 1,2,3,4,5,6,7,8,9,10))THEN 82 CALL ctl_stop('lim_trp_2 : requested workspace arrays unavailable.') 83 RETURN 84 END IF 77 85 78 86 IF( kt == nit000 ) CALL lim_trp_init_2 ! Initialization (first time-step only) … … 266 274 ENDIF 267 275 ! 276 IF(.NOT. wrk_release(2, 1,2,3,4,5,6,7,8,9,10))THEN 277 CALL ctl_stop('lim_trp_2 : failed to release workspace arrays.') 278 END IF 279 ! 268 280 END SUBROUTINE lim_trp_2 269 281 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90
r2528 r2590 39 39 #endif 40 40 PUBLIC lim_wri_state_2 ! called by dia_wri_state 41 PUBLIC lim_wri_alloc_2 ! called by nemogcm.F90 41 42 42 43 INTEGER, PARAMETER :: jpnoumax = 40 ! maximum number of variable for ice output … … 50 51 51 52 INTEGER :: nice, nhorid, ndim, niter, ndepid ! ???? 52 INTEGER , DIMENSION( jpij ) :: ndex51! ????53 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex51 ! ???? 53 54 54 55 REAL(wp) :: & ! constant values … … 57 58 zone = 1.e0 58 59 60 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcmo ! Workspace array for netcdf writer. 61 62 59 63 !! * Substitutions 60 64 # include "vectopt_loop_substitute.h90" … … 66 70 67 71 CONTAINS 72 73 FUNCTION lim_wri_alloc_2() 74 !!------------------------------------------------------------------- 75 !! *** ROUTINE lim_wri_alloc_2 *** 76 !!------------------------------------------------------------------- 77 IMPLICIT none 78 INTEGER :: lim_wri_alloc_2 79 !!------------------------------------------------------------------- 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 87 END FUNCTION lim_wri_alloc_2 88 68 89 69 90 #if ! defined key_iomput … … 85 106 !! of a day 86 107 !!------------------------------------------------------------------- 108 USE wrk_nemo, ONLY: wrk_use, wrk_release 109 USE wrk_nemo, ONLY: zfield => wrk_2d_1 110 !! 87 111 INTEGER, INTENT(in) :: kt ! number of iteration 88 112 !! … … 92 116 & zindh, zinda, zindb, ztmu 93 117 REAL(wp), DIMENSION(1) :: zdept 94 REAL(wp), DIMENSION(jpi,jpj) :: zfield 95 REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: zcmo 96 !!------------------------------------------------------------------- 118 !!------------------------------------------------------------------- 119 120 IF(.NOT. wrk_use(2, 1))THEN 121 CALL ctl_stop('lim_wri_2 : requested workspace array unavailable.') 122 RETURN 123 END IF 97 124 !--------------------! 98 125 IF( kt == nit000 ) THEN ! Initialisation ! … … 185 212 186 213 IF( ( nn_fsbc * niter ) >= nitend ) CALL histclo( nice ) 214 215 IF(.NOT. wrk_release(2, 1))THEN 216 CALL ctl_stop('lim_wri_2 : failed to release workspace array.') 217 END IF 187 218 188 219 END SUBROUTINE lim_wri_2 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90
r2528 r2590 25 25 ztmu 26 26 REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: & 27 zcmo 27 zcmo !ARPDBGWORK 28 28 REAL(wp), DIMENSION(jpi,jpj) :: & 29 29 zfield -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90
r2528 r2590 17 17 IMPLICIT NONE 18 18 PRIVATE 19 20 PUBLIC thd_ice_alloc_2 ! Routine called by nemogcm.F90 19 21 20 22 !! * Share Module variables … … 43 45 cnscg !: ratio rcpsn/rcpic 44 46 45 INTEGER , PUBLIC, DIMENSION(jpij) :: & !:47 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: & !: 46 48 npb , & !: number of points where computations has to be done 47 49 npac !: correspondance between the points 48 50 49 REAL(wp), PUBLIC, DIMENSION(jpij) :: & !:51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: & !: 50 52 qldif_1d , & !: corresponding to the 2D var qldif 51 53 qcmif_1d , & !: corresponding to the 2D var qcmif … … 80 82 dqla_ice_1d !: " " dqla_ice 81 83 82 REAL(wp), PUBLIC, DIMENSION(jpij,jplayersp1) :: & !:84 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: & !: 83 85 tbif_1d !: corresponding to the 2D var tbif 84 86 85 87 !!====================================================================== 88 CONTAINS 89 90 FUNCTION thd_ice_alloc_2() 91 USE in_out_manager, ONLY: ctl_warn 92 IMPLICIT none 93 INTEGER :: thd_ice_alloc_2 94 ! Local vars 95 INTEGER :: ierr(4) 96 97 ierr(:) = 0 98 99 ALLOCATE(npb(jpij), npac(jpij), & 100 qldif_1d(jpij), qcmif_1d(jpij), thcm_1d(jpij), & 101 fstbif_1d(jpij), fltbif_1d(jpij), fscbq_1d(jpij), & 102 qsr_ice_1d(jpij),fr1_i0_1d(jpij), fr2_i0_1d(jpij), Stat=ierr(1)) 103 104 ALLOCATE(qns_ice_1d(jpij), qfvbq_1d(jpij), sist_1d(jpij), tfu_1d(jpij), & 105 sprecip_1d(jpij), h_snow_1d(jpij),h_ice_1d(jpij),frld_1d(jpij),& 106 qstbif_1d(jpij), fbif_1d(jpij), Stat=ierr(2)) 107 108 ALLOCATE(rdmicif_1d(jpij), rdmsnif_1d(jpij), qlbbq_1d(jpij), & 109 dmgwi_1d(jpij) , dvsbq_1d(jpij) , rdvomif_1d(jpij), & 110 dvbbq_1d(jpij) , dvlbq_1d(jpij) , dvnbq_1d(jpij) , & 111 Stat=ierr(3)) 112 113 ALLOCATE(dqns_ice_1d(jpij) ,qla_ice_1d(jpij), dqla_ice_1d(jpij), & 114 tbif_1d(jpij, jplayersp1), Stat=ierr(4)) 115 116 thd_ice_alloc_2 = MAXVAL(ierr) 117 118 IF(thd_ice_alloc_2 /= 0)THEN 119 CALL ctl_warn('thd_ice_alloc_2: failed to allocate arrays.') 120 END IF 121 122 END FUNCTION thd_ice_alloc_2 123 86 124 #endif 87 125 END MODULE thd_ice_2 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90
r2528 r2590 11 11 PRIVATE 12 12 13 PUBLIC dom_ice_alloc ! Routine called by nemogcm.F90 14 13 15 LOGICAL, PUBLIC :: l_jeq = .TRUE. !: Equator inside the domain flag 14 16 15 17 INTEGER, PUBLIC :: njeq , njeqm1 !: j-index of the equator if it is inside the domain 16 18 17 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: fs2cor !: coriolis factor18 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: fcor !: coriolis coefficient19 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: covrai !: sine of geographic latitude20 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: area !: surface of grid cell21 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tms, tmi !: temperature mask, mask for stress22 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tmu, tmv !: mask at u and v velocity points23 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tmf !: mask at f-point19 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fs2cor !: coriolis factor 20 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcor !: coriolis coefficient 21 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: covrai !: sine of geographic latitude 22 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: area !: surface of grid cell 23 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tms, tmi !: temperature mask, mask for stress 24 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmu, tmv !: mask at u and v velocity points 25 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmf !: mask at f-point 24 26 25 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2) :: wght!: weight of the 4 neighbours to compute averages27 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wght !: weight of the 4 neighbours to compute averages 26 28 27 29 !!---------------------------------------------------------------------- … … 30 32 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 31 33 !!====================================================================== 34 CONTAINS 35 36 FUNCTION dom_ice_alloc 37 !!------------------------------------------------------------------- 38 !! *** Routine dom_ice_alloc *** 39 !!------------------------------------------------------------------- 40 INTEGER :: dom_ice_alloc 41 !!------------------------------------------------------------------- 42 43 ALLOCATE(fs2cor(jpi,jpj), fcor(jpi,jpj), & 44 covrai(jpi,jpj), area(jpi,jpj), & 45 tms(jpi,jpj) , tmi(jpi,jpj) , & 46 tmu(jpi,jpj) , tmv(jpi,jpj) , & 47 tmf(jpi,jpj) , & 48 wght(jpi,jpj,2,2), Stat = dom_ice_alloc) 49 50 IF(dom_ice_alloc /= 0)THEN 51 CALL ctl_warn('dom_ice_alloc: failed to allocate arrays.') 52 END IF 53 54 END FUNCTION dom_ice_alloc 55 32 56 END MODULE dom_ice -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r2528 r2590 27 27 USE prtctl ! Print control 28 28 USE lib_mpp 29 USE wrk_nemo, ONLY: wrk_use, wrk_release 29 30 30 31 IMPLICIT NONE … … 39 40 PUBLIC lim_itd_me_init 40 41 PUBLIC lim_itd_me_zapsmall 42 PUBLIC lim_idt_me_alloc ! called by nemogcm.F90 41 43 42 44 !! * Module variables … … 51 53 ! Variables shared among ridging subroutines 52 54 !----------------------------------------------------------------------- 53 REAL(wp), DIMENSION (jpi,jpj) :: &55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:) :: & 54 56 asum , & ! sum of total ice and open water area 55 57 aksum ! ratio of area removed to area ridged 56 58 57 REAL(wp), DIMENSION(jpi,jpj,0:jpl) :: &59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: & 58 60 athorn ! participation function; fraction of ridging/ 59 61 ! closing associated w/ category n 60 62 61 REAL(wp), DIMENSION(jpi,jpj,jpl) :: &63 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: & 62 64 hrmin , & ! minimum ridge thickness 63 65 hrmax , & ! maximum ridge thickness … … 78 80 !----------------------------------------------------------------------- 79 81 ! 80 REAL (wp), DIMENSION(jpi,jpj) :: &82 REAL (wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: & 81 83 dardg1dt , & ! rate of fractional area loss by ridging ice (1/s) 82 84 dardg2dt , & ! rate of fractional area gain by new ridges (1/s) … … 96 98 !!-----------------------------------------------------------------------------! 97 99 !!-----------------------------------------------------------------------------! 100 101 FUNCTION lim_idt_me_alloc() 102 !!---------------------------------------------------------------------! 103 !! *** ROUTINE lim_itd_me_alloc *** 104 !!---------------------------------------------------------------------! 105 INTEGER :: lim_idt_me_alloc 106 !!---------------------------------------------------------------------! 107 108 ALLOCATE(asum(jpi,jpj), aksum(jpi,jpj), athorn(jpi,jpj,0:jpl), & 109 ! 110 hrmin(jpi,jpj,jpl), hrmax(jpi,jpj,jpl) , & 111 hraft(jpi,jpj,jpl), krdg(jpi,jpj,jpl) , & 112 aridge(jpi,jpj,jpl), araft(jpi,jpj,jpl) , & 113 ! 114 dardg1dt(jpi,jpj) , dardg2dt(jpi,jpj) , & 115 dvirdgdt(jpi,jpj) , opening(jpi,jpj) , & 116 ! 117 Stat=lim_idt_me_alloc) 118 119 IF(lim_idt_me_alloc /= 0)THEN 120 CALL ctl_warn('lim_idt_me_alloc: failed to allocate arrays.') 121 END IF 122 123 END FUNCTION lim_idt_me_alloc 124 98 125 99 126 SUBROUTINE lim_itd_me ! (subroutine 1/6) … … 149 176 !! and Elizabeth C. Hunke, LANL are gratefully acknowledged 150 177 !!--------------------------------------------------------------------! 178 USE wrk_nemo, ONLY: & 179 closing_net => wrk_2d_1, & ! net rate at which area is removed (1/s) 180 ! (ridging ice area - area of new ridges) / dt 181 divu_adv => wrk_2d_2, & ! divu as implied by transport scheme (1/s) 182 opning => wrk_2d_3, & ! rate of opening due to divergence/shear 183 closing_gross => wrk_2d_4, & ! rate at which area removed, not counting 184 ! area of new ridges 185 msnow_mlt => wrk_2d_5, & ! mass of snow added to ocean (kg m-2) 186 esnow_mlt => wrk_2d_6 ! energy needed to melt snow in ocean (J m-2) 187 USE wrk_nemo, ONLY: vt_i_init => wrk_2d_7, & ! ice volume summed over 188 vt_i_final => wrk_2d_8 ! categories 189 151 190 !! * Arguments 152 191 … … 164 203 epsi06 = 1.0e-6 165 204 166 REAL(wp), DIMENSION(jpi,jpj) :: &167 closing_net, & ! net rate at which area is removed (1/s)168 ! (ridging ice area - area of new ridges) / dt169 divu_adv , & ! divu as implied by transport scheme (1/s)170 opning , & ! rate of opening due to divergence/shear171 closing_gross, & ! rate at which area removed, not counting172 ! area of new ridges173 msnow_mlt , & ! mass of snow added to ocean (kg m-2)174 esnow_mlt ! energy needed to melt snow in ocean (J m-2)175 176 205 REAL(wp) :: & 177 206 w1, & ! temporary variable … … 187 216 big = 1.0e8 188 217 189 REAL (wp), DIMENSION(jpi,jpj) :: & !190 vt_i_init, vt_i_final ! ice volume summed over categories191 192 218 CHARACTER (len = 15) :: fieldid 193 219 194 220 !!-- End of declarations 195 221 !-----------------------------------------------------------------------------! 222 223 IF(.NOT. wrk_use(2, 1,2,3,4,5,6,7,8))THEN 224 CALL ctl_stop(' : requested workspace arrays unavailable.') 225 RETURN 226 END IF 196 227 197 228 IF( numit == nstart ) CALL lim_itd_me_init ! Initialization (first time-step only) … … 551 582 END DO 552 583 584 IF(.NOT. wrk_release(2, 1,2,3,4,5,6,7,8))THEN 585 CALL ctl_stop('lim_itd_me : failed to release workspace arrays.') 586 END IF 587 553 588 END SUBROUTINE lim_itd_me 554 589 … … 577 612 !! 578 613 !!---------------------------------------------------------------------- 614 USE wrk_nemo, ONLY: zworka => wrk_2d_1 !: temporary array used here 615 ! 579 616 !! * Arguments 580 617 … … 594 631 zdummy 595 632 596 REAL(wp), DIMENSION(jpi,jpj) :: & 597 zworka !: temporary array used here 633 IF(.NOT. wrk_use(2, 1))THEN 634 CALL ctl_stop('lim_itd_me_icestrength : requested workspace array unavailable.') 635 RETURN 636 END IF 598 637 599 638 !------------------------------------------------------------------------------! … … 765 804 ! Boundary conditions 766 805 CALL lbc_lnk( strength, 'T', 1. ) 806 807 IF(.NOT. wrk_release(2, 1))THEN 808 CALL ctl_stop('lim_itd_me_icestrength : failed to release workspace array.') 809 END IF 767 810 768 811 END SUBROUTINE lim_itd_me_icestrength -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r2580 r2590 37 37 PRIVATE 38 38 39 PUBLIC lim_rhg ! routine called by lim_dyn (or lim_dyn_2) 39 PUBLIC lim_rhg ! routine called by lim_dyn (or lim_dyn_2) 40 PUBLIC lim_rhg_alloc ! routine called by nemo_alloc in nemogcm.F90 40 41 41 42 REAL(wp) :: rzero = 0._wp ! constant values 42 43 REAL(wp) :: rone = 1._wp ! constant values 43 44 45 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: & 46 zpresh , & !: temporary array for ice strength 47 zpreshc , & !: Ice strength on grid cell corners (zpreshc) 48 zfrld1, zfrld2, & !: lead fraction on U/V points 49 zmass1, zmass2, & !: ice/snow mass on U/V points 50 zcorl1, zcorl2, & !: coriolis parameter on U/V points 51 za1ct, za2ct , & !: temporary arrays 52 zc1 , & !: ice mass 53 zusw , & !: temporary weight for the computation 54 !: of ice strength 55 u_oce1, v_oce1, & !: ocean u/v component on U points 56 u_oce2, v_oce2, & !: ocean u/v component on V points 57 u_ice2, & !: ice u component on V point 58 v_ice1 !: ice v component on U point 59 60 REAL(wp),ALLOCATABLE, SAVE, DIMENSION(:,:) :: zf1, zf2 ! arrays for internal stresses 61 62 REAL(wp),ALLOCATABLE, SAVE, DIMENSION(:,:) :: & 63 zdd, zdt, & ! Divergence and tension at centre of grid cells 64 zds, & ! Shear on northeast corner of grid cells 65 deltat, & ! Delta at centre of grid cells 66 deltac, & ! Delta on corners 67 zs1, zs2, & ! Diagonal stress tensor components zs1 and zs2 68 zs12 ! Non-diagonal stress tensor component zs12 69 70 REAL(wp),ALLOCATABLE, SAVE, DIMENSION(:,:) :: zu_ice, zv_ice, zresr ! Local error on velocity 71 44 72 !! * Substitutions 45 73 # include "vectopt_loop_substitute.h90" … … 50 78 !!---------------------------------------------------------------------- 51 79 CONTAINS 80 81 FUNCTION lim_rhg_alloc() 82 !!------------------------------------------------------------------- 83 !! *** FUNCTION lim_rhg_alloc *** 84 !!------------------------------------------------------------------- 85 IMPLICIT none 86 INTEGER :: lim_rhg_alloc 87 INTEGER :: ierr(2) 88 !!------------------------------------------------------------------- 89 90 ierr(:) = 0 91 92 ALLOCATE(zpresh(jpi,jpj), zpreshc(jpi,jpj), & 93 zfrld1(jpi,jpj), zfrld2(jpi,jpj), & 94 zmass1(jpi,jpj), zmass2(jpi,jpj), & 95 zcorl1(jpi,jpj), zcorl2(jpi,jpj), & 96 za1ct(jpi,jpj), za2ct(jpi,jpj) , & 97 zc1(jpi,jpj) , zusw(jpi,jpj) , & 98 u_oce1(jpi,jpj), v_oce1(jpi,jpj), & 99 u_oce2(jpi,jpj), v_oce2(jpi,jpj), & 100 u_ice2(jpi,jpj), v_ice1(jpi,jpj), Stat=ierr(1)) 101 102 ALLOCATE(zf1(jpi,jpj), zf2(jpi,jpj), & 103 zdd(jpi,jpj), zdt(jpi,jpj), zds(jpi,jpj), & 104 deltat(jpi,jpj), deltac(jpi,jpj), & 105 zs1(jpi,jpj), zs2(jpi,jpj), zs12(jpi,jpj),& 106 zu_ice(jpi,jpj), zv_ice(jpi,jpj), & 107 zresr(jpi,jpj), Stat=ierr(2)) 108 109 lim_rhg_alloc = MAXVAL(ierr) 110 111 END FUNCTION lim_rhg_alloc 112 52 113 53 114 SUBROUTINE lim_rhg( k_j1, k_jpj ) … … 111 172 REAL(wp) :: za, zstms, zsang, zmask ! local scalars 112 173 113 REAL(wp),DIMENSION(jpi,jpj) :: &114 zpresh , & !: temporary array for ice strength115 zpreshc , & !: Ice strength on grid cell corners (zpreshc)116 zfrld1, zfrld2, & !: lead fraction on U/V points117 zmass1, zmass2, & !: ice/snow mass on U/V points118 zcorl1, zcorl2, & !: coriolis parameter on U/V points119 za1ct, za2ct , & !: temporary arrays120 zc1 , & !: ice mass121 zusw , & !: temporary weight for the computation122 !: of ice strength123 u_oce1, v_oce1, & !: ocean u/v component on U points124 u_oce2, v_oce2, & !: ocean u/v component on V points125 u_ice2, & !: ice u component on V point126 v_ice1 !: ice v component on U point127 128 174 REAL(wp) :: & 129 175 dtevp, & ! time step for subcycling … … 140 186 sigma1, sigma2 ! internal ice stress 141 187 142 REAL(wp),DIMENSION(jpi,jpj) :: zf1, zf2 ! arrays for internal stresses143 144 REAL(wp),DIMENSION(jpi,jpj) :: &145 zdd, zdt, & ! Divergence and tension at centre of grid cells146 zds, & ! Shear on northeast corner of grid cells147 deltat, & ! Delta at centre of grid cells148 deltac, & ! Delta on corners149 zs1, zs2, & ! Diagonal stress tensor components zs1 and zs2150 zs12 ! Non-diagonal stress tensor component zs12151 152 188 REAL(wp) :: & 153 189 zresm , & ! Maximal error on ice velocity … … 155 191 zdummy ! dummy argument 156 192 157 REAL(wp),DIMENSION(jpi,jpj) :: zu_ice, zv_ice, zresr ! Local error on velocity158 193 !!------------------------------------------------------------------- 159 194 #if defined key_lim2 && ! defined key_lim2_vp -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r2528 r2590 16 16 IMPLICIT NONE 17 17 PRIVATE 18 19 PUBLIC thd_ice_alloc ! Routine called by nemogcm.F90 18 20 19 21 !!--------------------------- … … 51 53 !: are the variables corresponding to 2d vectors 52 54 53 INTEGER , PUBLIC, DIMENSION(jpij) :: & !:55 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: & !: 54 56 npb , & !: number of points where computations has to be done 55 57 npac !: correspondance between the points (lateral accretion) 56 58 57 REAL(wp), PUBLIC, DIMENSION(jpij) :: & !:59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: & !: 58 60 qldif_1d , & !: corresponding to the 2D var qldif 59 61 qcmif_1d , & !: corresponding to the 2D var qcmif … … 68 70 t_bo_b !: " " t_bo 69 71 70 REAL(wp), PUBLIC, DIMENSION(jpij) :: & !:72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: & !: 71 73 sprecip_1d , & !: " " sprecip 72 74 frld_1d , & !: " " frld … … 106 108 hicol_b !: Ice collection thickness accumulated in fleads 107 109 108 REAL(wp), PUBLIC, DIMENSION(jpij) :: & !:110 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: & !: 109 111 t_su_b , & !: " " t_su 110 112 a_i_b , & !: a_i … … 122 124 o_i_b !: Ice age [days] 123 125 124 REAL(wp), PUBLIC, DIMENSION(jpij,nlay_s) :: & !:126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: & !: 125 127 t_s_b !: corresponding to the 2D var t_s 126 REAL(wp), PUBLIC, DIMENSION(jpij,jkmax) :: & !:128 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: & !: 127 129 t_i_b, & !: corresponding to the 2D var t_i 128 130 s_i_b, & !: profiled ice salinity … … 132 134 ! Clean the following ... 133 135 ! These variables are coded for conservation checks 134 REAL(wp), PUBLIC, DIMENSION(jpij,jpl) :: & !136 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: & ! 135 137 qt_i_in , & !: ice energy summed over categories (initial) 136 138 qt_i_fin , & !: ice energy summed over categories (final) … … 140 142 cons_error, surf_error !: conservation, surface error 141 143 142 REAL(wp), PUBLIC, DIMENSION(jpij,jkmax):: & !: goes to trash144 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:):: & !: goes to trash 143 145 q_i_layer_in, & 144 146 q_i_layer_fin, & 145 147 dq_i_layer, radab 146 148 147 REAL(wp), PUBLIC, DIMENSION(jpij) :: & !:149 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: & !: 148 150 ftotal_in , & !: initial total heat flux 149 151 ftotal_fin !: final total heat flux 150 152 151 REAL(wp), PUBLIC, DIMENSION(jpij,0:nlay_s) :: & !:153 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: & !: 152 154 fc_s 153 REAL(wp), PUBLIC, DIMENSION(jpij,0:jkmax) :: & !:155 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: & !: 154 156 fc_i 155 REAL(wp), PUBLIC, DIMENSION(jpij,nlay_s) :: & !:157 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: & !: 156 158 de_s_lay 157 REAL(wp), PUBLIC, DIMENSION(jpij,jkmax) :: & !:159 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: & !: 158 160 de_i_lay 159 161 INTEGER , PUBLIC :: & … … 161 163 162 164 !!====================================================================== 165 CONTAINS 166 167 FUNCTION thd_ice_alloc() 168 !!---------------------------------------------------------------------! 169 !! *** ROUTINE thd_ice_alloc *** 170 !!---------------------------------------------------------------------! 171 INTEGER :: thd_ice_alloc 172 INTEGER :: ierr(4) 173 !!---------------------------------------------------------------------! 174 175 ALLOCATE(npb(jpij) , npac(jpij), & 176 ! 177 qldif_1d(jpij) , qcmif_1d(jpij) , fstbif_1d(jpij) , & 178 fltbif_1d(jpij), fscbq_1d(jpij) , qsr_ice_1d(jpij) , & 179 fr1_i0_1d(jpij), fr2_i0_1d(jpij), qnsr_ice_1d(jpij) , & 180 qfvbq_1d(jpij) , t_bo_b(jpij) , & 181 Stat=ierr(1)) 182 ! 183 ALLOCATE(sprecip_1d(jpij), frld_1d(jpij) , at_i_b(jpij) , & 184 fbif_1d(jpij) , rdmicif_1d(jpij), rdmsnif_1d(jpij), & 185 qlbbq_1d(jpij) , dmgwi_1d(jpij) , dvsbq_1d(jpij) , & 186 dvbbq_1d(jpij) , dvlbq_1d(jpij) , dvnbq_1d(jpij) , & 187 dqns_ice_1d(jpij),qla_ice_1d(jpij), dqla_ice_1d(jpij),& 188 tatm_ice_1d(jpij),fsup(jpij) , focea(jpij) , & 189 i0(jpij) , old_ht_i_b(jpij), old_ht_s_b(jpij), & 190 fsbri_1d(jpij) , fhbri_1d(jpij) , fseqv_1d(jpij) , & 191 dsm_i_fl_1d(jpij),dsm_i_gd_1d(jpij),dsm_i_se_1d(jpij),& 192 dsm_i_si_1d(jpij),hicol_b(jpij) , & 193 Stat=ierr(2)) 194 ! 195 ALLOCATE(t_su_b(jpij) , a_i_b(jpij) , ht_i_b(jpij) , & 196 ht_s_b(jpij) , fc_su(jpij) , fc_bo_i(jpij) , & 197 dh_s_tot(jpij) , dh_i_surf(jpij), dh_i_bott(jpij) , & 198 dh_snowice(jpij) , sm_i_b(jpij) , s_i_new(jpij) , & 199 s_snowice(jpij) , o_i_b(jpij) , & 200 ! 201 t_s_b(jpij,nlay_s), & 202 ! 203 t_i_b(jpij,jkmax), s_i_b(jpij,jkmax) , & 204 q_i_b(jpij,jkmax), q_s_b(jpij,jkmax) , & 205 Stat=ierr(3)) 206 ! 207 ALLOCATE(qt_i_in(jpij,jpl) , qt_i_fin(jpij,jpl), qt_s_in(jpij,jpl), & 208 qt_s_fin(jpij,jpl), dq_i(jpij,jpl) , sum_fluxq(jpij,jpl), & 209 fatm(jpij,jpl), foce(jpij,jpl) , cons_error(jpij,jpl),& 210 surf_error(jpij,jpl), & 211 ! 212 q_i_layer_in(jpij,jkmax), q_i_layer_fin(jpij,jkmax), & 213 dq_i_layer(jpij,jkmax) , radab(jpij,jkmax), & 214 ! 215 ftotal_in(jpij), ftotal_fin(jpij), & 216 ! 217 fc_s(jpij,0:nlay_s), fc_i(jpij,0:jkmax) , & 218 de_s_lay(jpij,nlay_s), de_i_lay(jpij,jkmax) , & 219 ! 220 Stat=ierr(4)) 221 222 thd_ice_alloc = MAXVAL(ierr) 223 224 IF(thd_ice_alloc /= 0)THEN 225 CALL ctl_warn('thd_ice_alloc: failed to allocate arrays.') 226 END IF 227 228 END FUNCTION thd_ice_alloc 229 163 230 END MODULE thd_ice -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
r2528 r2590 48 48 !! Global variables 49 49 !!---------------------------------------------------------------------- 50 REAL(wp), DIMENSION(jpi,jpj) :: bdytmask !: Mask defining computational domain at T-points51 REAL(wp), DIMENSION(jpi,jpj) :: bdyumask !: Mask defining computational domain at U-points52 REAL(wp), DIMENSION(jpi,jpj) :: bdyvmask !: Mask defining computational domain at V-points50 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: bdytmask !: Mask defining computational domain at T-points 51 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: bdyumask !: Mask defining computational domain at U-points 52 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: bdyvmask !: Mask defining computational domain at V-points 53 53 54 54 !!---------------------------------------------------------------------- … … 70 70 REAL(wp), DIMENSION(jpbdim) :: sshbdy !: Now clim of bdy sea surface height (Flather) 71 71 REAL(wp), DIMENSION(jpbdim) :: ubtbdy, vbtbdy !: Now clim of bdy barotropic velocity components 72 REAL(wp), DIMENSION(jpbdim,jpk) :: tbdy , sbdy !: Now clim of bdy temperature and salinity73 REAL(wp), DIMENSION(jpbdim,jpk) :: ubdy , vbdy !: Now clim of bdy velocity components72 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: tbdy , sbdy !: Now clim of bdy temperature and salinity 73 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubdy , vbdy !: Now clim of bdy velocity components 74 74 REAL(wp), DIMENSION(jpbdim) :: sshtide !: Tidal boundary array : SSH 75 75 REAL(wp), DIMENSION(jpbdim) :: utide, vtide !: Tidal boundary array : U and V … … 92 92 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 93 93 !!====================================================================== 94 #if defined key_bdy 95 CONTAINS 96 97 FUNCTION bdy_oce_alloc() 98 INTEGER :: bdy_oce_alloc 99 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)THEN 106 CALL ctl_warn('bdy_oce_alloc: failed to allocate arrays.') 107 END IF 108 109 END FUNCTION bdy_oce_alloc 110 #endif 111 94 112 END MODULE bdy_oce -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r2528 r2590 25 25 PUBLIC dia_ar5 ! routine called in step.F90 module 26 26 PUBLIC dia_ar5_init ! routine called in opa.F90 module 27 PUBLIC dia_ar5_alloc ! routine called in nemogcm.F90 module 27 28 28 29 LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .TRUE. ! coupled flag … … 30 31 REAL(wp) :: vol0 ! ocean volume (interior domain) 31 32 REAL(wp) :: area_tot ! total ocean surface (interior domain) 32 REAL(wp), DIMENSION(jpi,jpj) :: area ! cell surface (interior domain)33 REAL(wp), DIMENSION(jpi,jpj) :: thick0 ! ocean thickness (interior domain)34 REAL(wp), DIMENSION(jpi,jpj,jpk) :: sn0 ! initial salinity33 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,: ) :: area ! cell surface (interior domain) 34 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,: ) :: thick0 ! ocean thickness (interior domain) 35 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sn0 ! initial salinity 35 36 36 37 !! * Substitutions … … 43 44 CONTAINS 44 45 46 FUNCTION dia_ar5_alloc() 47 !!---------------------------------------------------------------------- 48 !! *** ROUTINE dia_ar5_alloc *** 49 !!---------------------------------------------------------------------- 50 INTEGER :: dia_ar5_alloc 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 60 END FUNCTION dia_ar5_alloc 61 62 45 63 SUBROUTINE dia_ar5( kt ) 46 64 !!---------------------------------------------------------------------- … … 50 68 !! 51 69 !!---------------------------------------------------------------------- 70 USE wrk_nemo, ONLY: wrk_use, wrk_release 71 USE wrk_nemo, ONLY: zarea_ssh => wrk_2d_1, zbotpres => wrk_2d_2 72 USE wrk_nemo, ONLY: zrhd => wrk_3d_1, zrhop => wrk_3d_2 73 USE wrk_nemo, ONLY: ztsn => wrk_4d_1 74 !! 52 75 INTEGER, INTENT( in ) :: kt ! ocean time-step index 53 76 !! 54 77 INTEGER :: ji, jj, jk ! dummy loop arguments 55 78 REAL(wp) :: zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass 56 REAL(wp), DIMENSION(jpi,jpj ) :: zarea_ssh, zbotpres57 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrhd, zrhop58 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: ztsn59 79 !!-------------------------------------------------------------------- 80 81 IF( (.NOT. wrk_use(2, 1,2)) .OR. & 82 (.NOT. wrk_use(3, 1,2)) .OR. & 83 (.NOT. wrk_use(4, 1)) )THEN 84 CALL ctl_stop('dia_ar5: requested workspace arrays unavailable') 85 RETURN 86 END IF 60 87 61 88 CALL iom_put( 'cellthc', fse3t(:,:,:) ) … … 137 164 CALL iom_put( 'saltot' , zsal ) 138 165 ! 166 IF( (.NOT. wrk_release(2, 1,2)) .OR. & 167 (.NOT. wrk_release(3, 1,2)) .OR. & 168 (.NOT. wrk_release(4, 1)) )THEN 169 CALL ctl_stop('dia_ar5: failed to release workspace arrays') 170 END IF 171 ! 139 172 END SUBROUTINE dia_ar5 140 173 … … 146 179 !! ** Purpose : initialization for AR5 diagnostic computation 147 180 !!---------------------------------------------------------------------- 181 USE wrk_nemo, ONLY: wrk_use, wrk_release 182 USE wrk_nemo, ONLY: wrk_4d_1 183 !! 148 184 INTEGER :: inum 149 185 INTEGER :: ik 150 186 INTEGER :: ji, jj, jk ! dummy loop indices 151 187 REAL(wp) :: zztmp 152 REAL(wp), DIMENSION(jpi,jpj,jpk, 2) :: zsaldta ! Jan/Dec levitus salinity 153 !!---------------------------------------------------------------------- 154 ! 188 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 189 !!---------------------------------------------------------------------- 190 ! 191 IF(.NOT. wrk_use(4, 1))THEN 192 CALL ctl_stop('dia_ar5_init: requested workspace array unavailable.') 193 RETURN 194 END IF 195 zsaldta => wrk_4d_1(:,:,:,1:2) 196 155 197 area(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) 156 198 … … 183 225 ENDIF 184 226 ! 227 IF(.NOT. wrk_release(4, 1))THEN 228 CALL ctl_stop('dia_ar5_init: failed to release workspace array.') 229 END IF 230 ! 185 231 END SUBROUTINE dia_ar5_init 186 232 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90
r2528 r2590 17 17 !! * Accessibility 18 18 PUBLIC dia_wri_dimg ! called by trd_mld (eg) 19 PUBLIC dia_wri_dimg_alloc ! called by nemo_alloc in nemogcm.F90 19 20 20 21 !! * Substitutions 21 22 # include "domzgr_substitute.h90" 23 24 !! These workspace arrays are inside the module so that we can make them 25 !! allocatable in a clean way. Not done in wrk_nemo because these are 26 !! of KIND(sp). 27 REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: z42d ! 2d temporary workspace (sp) 28 REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:) :: z4dep ! vertical level (sp) 22 29 23 30 !!---------------------------------------------------------------------- … … 28 35 29 36 CONTAINS 37 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 52 END FUNCTION dia_wri_dimg_alloc 53 30 54 31 55 SUBROUTINE dia_wri_dimg(cd_name, cd_text, ptab, klev, cd_type , ksubi ) … … 63 87 REAL(sp) :: zdx,zdy,zspval,zwest,ztimm 64 88 REAL(sp) :: zsouth 65 REAL(sp),DIMENSION(jpi,jpj) :: z42d ! 2d temporary workspace (sp)66 REAL(sp),DIMENSION(jpk) :: z4dep ! vertical level (sp)67 89 68 90 CHARACTER(LEN=80) :: clname ! name of file in case of dimgnnn -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
r2561 r2590 26 26 PRIVATE 27 27 28 PUBLIC dia_hth ! routine called by step.F90 28 PUBLIC dia_hth ! routine called by step.F90 29 PUBLIC dia_hth_alloc ! routine called by nemogcm.F90 29 30 30 31 LOGICAL , PUBLIC, PARAMETER :: lk_diahth = .TRUE. !: thermocline-20d depths flag 31 32 ! note: following variables should move to local variables once iom_put is always used 32 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hth !: depth of the max vertical temperature gradient [m]33 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hd20 !: depth of 20 C isotherm [m]34 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hd28 !: depth of 28 C isotherm [m]35 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: htc3 !: heat content of first 300 m [W]33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hth !: depth of the max vertical temperature gradient [m] 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hd20 !: depth of 20 C isotherm [m] 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hd28 !: depth of 28 C isotherm [m] 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: htc3 !: heat content of first 300 m [W] 36 37 37 38 !! * Substitutions … … 43 44 !!---------------------------------------------------------------------- 44 45 CONTAINS 46 47 FUNCTION dia_hth_alloc() 48 !!--------------------------------------------------------------------- 49 IMPLICIT none 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)THEN 56 CALL ctl_warn('dia_hth_alloc: failed to allocate arrays.') 57 END IF 58 END FUNCTION dia_hth_alloc 45 59 46 60 SUBROUTINE dia_hth( kt ) … … 68 82 INTEGER :: ji, jj, jk ! dummy loop arguments 69 83 INTEGER :: iid, ilevel ! temporary integers 70 INTEGER, DIMENSION(jpi,jpj) :: ik20, ik28! levels84 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ik20, ik28 ! levels 71 85 REAL(wp) :: zavt5 = 5.e-4_wp ! Kz criterion for the turbocline depth 72 86 REAL(wp) :: zrho3 = 0.03_wp ! density criterion for mixed layer depth … … 76 90 REAL(wp) :: zztmp, zzdep ! temporary scalars inside do loop 77 91 REAL(wp) :: zu, zv, zw, zut, zvt ! temporary workspace 78 REAL(wp), DIMENSION(jpi,jpj) :: zabs2! MLD: abs( tn - tn(10m) ) = ztem279 REAL(wp), DIMENSION(jpi,jpj) :: ztm2! Top of thermocline: tn = tn(10m) - ztem280 REAL(wp), DIMENSION(jpi,jpj) :: zrho10_3! MLD: rho = rho10m + zrho381 REAL(wp), DIMENSION(jpi,jpj) :: zpycn! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC)82 REAL(wp), DIMENSION(jpi,jpj) :: ztinv! max of temperature inversion83 REAL(wp), DIMENSION(jpi,jpj) :: zdepinv! depth of temperature inversion84 REAL(wp), DIMENSION(jpi,jpj) :: zrho0_3! MLD rho = rho(surf) = 0.0385 REAL(wp), DIMENSION(jpi,jpj) :: zrho0_1! MLD rho = rho(surf) = 0.0186 REAL(wp), DIMENSION(jpi,jpj) :: zmaxdzT! max of dT/dz87 REAL(wp), DIMENSION(jpi,jpj) :: zthick! vertical integration thickness88 REAL(wp), DIMENSION(jpi,jpj) :: zdelr! delta rho equivalent to deltaT = 0.292 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zabs2 ! MLD: abs( tn - tn(10m) ) = ztem2 93 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ztm2 ! Top of thermocline: tn = tn(10m) - ztem2 94 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zrho10_3 ! MLD: rho = rho10m + zrho3 95 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zpycn ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC) 96 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ztinv ! max of temperature inversion 97 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zdepinv ! depth of temperature inversion 98 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zrho0_3 ! MLD rho = rho(surf) = 0.03 99 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zrho0_1 ! MLD rho = rho(surf) = 0.01 100 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zmaxdzT ! max of dT/dz 101 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zthick ! vertical integration thickness 102 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zdelr ! delta rho equivalent to deltaT = 0.2 89 103 !!---------------------------------------------------------------------- 90 104 91 105 IF( kt == nit000 ) THEN 106 107 IF(.not. ALLOCATED(ik20))THEN 108 ALLOCATE(ik20(jpi,jpj), ik28(jpi,jpj), & 109 zabs2(jpi,jpj), & 110 ztm2(jpi,jpj), & 111 zrho10_3(jpi,jpj),& 112 zpycn(jpi,jpj), & 113 ztinv(jpi,jpj), & 114 zdepinv(jpi,jpj), & 115 zrho0_3(jpi,jpj), & 116 zrho0_1(jpi,jpj), & 117 zmaxdzT(jpi,jpj), & 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 124 END IF 125 92 126 IF(lwp) WRITE(numout,*) 93 127 IF(lwp) WRITE(numout,*) 'dia_hth : diagnostics of the thermocline depth' -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r2571 r2590 41 41 PUBLIC ptr_vj ! call by tra_ldf & tra_adv routines 42 42 PUBLIC ptr_vjk ! call by tra_ldf & tra_adv routines 43 PUBLIC dia_ptr_alloc ! call in nemogcm module 43 44 44 45 ! !!** namelist namptr ** … … 71 72 REAL(wp) :: rc_pwatt = 1.e-15_wp ! conversion from W to PW (further x rau0 x Cp) 72 73 REAL(wp) :: rc_ggram = 1.e-6_wp ! conversion from g to Pg 74 75 REAL(wp), TARGET, DIMENSION(:), ALLOCATABLE, SAVE :: p_fval1d 76 REAL(wp), TARGET, DIMENSION(:,:), ALLOCATABLE, SAVE :: p_fval2d 77 78 !! Integer, 1D workspace arrays. Not common enough to be implemented in 79 !! wrk_nemo module. 80 INTEGER, ALLOCATABLE, SAVE, DIMENSION (:) :: ndex , ndex_atl , ndex_pac , ndex_ind , ndex_ipc 81 INTEGER, ALLOCATABLE, SAVE, DIMENSION (:) :: ndex_atl_30 , ndex_pac_30 , ndex_ind_30 , ndex_ipc_30 82 INTEGER, ALLOCATABLE, SAVE, DIMENSION (:) :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30 73 83 74 84 !! * Substitutions … … 82 92 CONTAINS 83 93 94 FUNCTION dia_ptr_alloc() 95 !!---------------------------------------------------------------------- 96 !! *** ROUTINE dia_ptr_alloc *** 97 !!---------------------------------------------------------------------- 98 INTEGER :: dia_ptr_alloc 99 INTEGER, DIMENSION(5) :: ierr 100 !!---------------------------------------------------------------------- 101 102 ierr(:) = 0 103 104 ALLOCATE( btmsk(jpi,jpj,nptr) , & 105 htr_adv(jpj) , str_adv(jpj) , & 106 htr_ldf(jpj) , str_ldf(jpj) , & 107 htr_ove(jpj) , str_ove(jpj), & 108 htr(jpj,nptr) , str(jpj,nptr) , & 109 tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) , & 110 sjk (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr) , STAT=ierr(1) ) 111 ! 112 #if defined key_diaeiv 113 ALLOCATE( htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , & 114 v_msf_eiv(jpj,jpk,nptr) , STAT=ierr(2) ) 115 #endif 116 117 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(3)) 118 119 ALLOCATE(ndex(jpj*jpk), ndex_atl(jpj*jpk), ndex_pac(jpj*jpk), & 120 ndex_ind(jpj*jpk), ndex_ipc(jpj*jpk), & 121 ndex_atl_30(jpj*jpk), ndex_pac_30(jpj*jpk), Stat=ierr(4)) 122 123 ALLOCATE(ndex_ind_30(jpj*jpk), ndex_ipc_30(jpj*jpk), & 124 ndex_h(jpj), ndex_h_atl_30(jpj), ndex_h_pac_30(jpj), & 125 ndex_h_ind_30(jpj), ndex_h_ipc_30(jpj), Stat=ierr(5)) 126 127 dia_ptr_alloc = MAXVAL(ierr) 128 129 END FUNCTION dia_ptr_alloc 130 131 84 132 FUNCTION ptr_vj_3d( pva ) RESULT ( p_fval ) 85 133 !!---------------------------------------------------------------------- … … 93 141 !! ** Action : - p_fval: i-k-mean poleward flux of pva 94 142 !!---------------------------------------------------------------------- 143 IMPLICIT none 95 144 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point 96 145 !! 97 146 INTEGER :: ji, jj, jk ! dummy loop arguments 98 147 INTEGER :: ijpj ! ??? 99 REAL(wp), DIMENSION(jpj) :: p_fval! function value148 REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 100 149 !!-------------------------------------------------------------------- 101 150 ! 151 p_fval => p_fval1d 152 102 153 ijpj = jpj 103 154 p_fval(:) = 0._wp … … 128 179 !! ** Action : - p_fval: i-k-mean poleward flux of pva 129 180 !!---------------------------------------------------------------------- 181 IMPLICIT none 130 182 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pva ! mask flux array at V-point 131 183 !! 132 INTEGER :: ji,jj ! dummy loop arguments133 INTEGER :: ijpj ! ???134 REAL(wp), DIMENSION(jpj) :: p_fval! function value184 INTEGER :: ji,jj ! dummy loop arguments 185 INTEGER :: ijpj ! ??? 186 REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 135 187 !!-------------------------------------------------------------------- 136 188 ! 189 p_fval => p_fval1d 190 137 191 ijpj = jpj 138 192 p_fval(:) = 0._wp … … 161 215 !! ** Action : - p_fval: i-mean poleward flux of pva 162 216 !!---------------------------------------------------------------------- 217 #if defined key_mpp_mpi 218 USE wrk_nemo, ONLY: wrk_use, wrk_release 219 USE wrk_nemo, ONLY: zwork => wrk_1d_1 220 #endif 221 !! 222 IMPLICIT none 163 223 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point 164 224 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL :: pmsk ! Optional 2D basin mask 165 225 !! 166 INTEGER :: ji, jj, jk! dummy loop arguments167 REAL(wp), DIMENSION(jpj,jpk) :: p_fval! return function value226 INTEGER :: ji, jj, jk ! dummy loop arguments 227 REAL(wp), POINTER, DIMENSION(:,:) :: p_fval ! return function value 168 228 #if defined key_mpp_mpi 169 229 INTEGER, DIMENSION(1) :: ish 170 230 INTEGER, DIMENSION(2) :: ish2 171 REAL(wp), DIMENSION(jpj*jpk) :: zwork ! 1D workspace231 INTEGER :: ijpjjpk 172 232 #endif 173 233 !!-------------------------------------------------------------------- 174 234 ! 235 #if defined key_mpp_mpi 236 IF(.not. wrk_use(1, 1))THEN 237 CALL ctl_stop('ptr_vjk: ERROR - requested workspace array is unavailable') 238 RETURN 239 END IF 240 #endif 241 242 p_fval => p_fval2d 243 175 244 p_fval(:,:) = 0._wp 176 245 ! … … 195 264 ! 196 265 #if defined key_mpp_mpi 197 ish(1) = jpj*jpk ; ish2(1) = jpj ; ish2(2) = jpk 198 zwork(:) = RESHAPE( p_fval, ish ) 199 CALL mpp_sum( zwork, jpj*jpk, ncomm_znl ) 266 ijpjjpk = jpj*jpk 267 ish(1) = ijpjjpk ; ish2(1) = jpj ; ish2(2) = jpk 268 zwork(1:ijpjjpk) = RESHAPE( p_fval, ish ) 269 CALL mpp_sum( zwork, ijpjjpk, ncomm_znl ) 200 270 p_fval(:,:) = RESHAPE( zwork, ish2 ) 201 271 #endif 202 272 ! 273 #if defined key_mpp_mpi 274 IF(.not. wrk_release(1, 1))THEN 275 CALL ctl_stop('ptr_vjk: ERROR - failed to release workspace array') 276 END IF 277 #endif 278 ! 203 279 END FUNCTION ptr_vjk 204 280 … … 214 290 !! ** Action : - p_fval: i-sum of e1t*e3t*pta 215 291 !!---------------------------------------------------------------------- 292 #if defined key_mpp_mpi 293 USE wrk_nemo, ONLY: wrk_use, wrk_release 294 USE wrk_nemo, ONLY: zwork => wrk_1d_1 295 #endif 296 !! 216 297 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pta ! tracer flux array at T-point 217 298 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask 218 299 !! 219 INTEGER ::ji, jj, jk ! dummy loop arguments220 REAL(wp), DIMENSION(jpj,jpk) ::p_fval ! return function value300 INTEGER :: ji, jj, jk ! dummy loop arguments 301 REAL(wp), POINTER, DIMENSION(:,:) :: p_fval ! return function value 221 302 #if defined key_mpp_mpi 222 303 INTEGER, DIMENSION(1) :: ish 223 304 INTEGER, DIMENSION(2) :: ish2 224 REAL(wp),DIMENSION(jpj*jpk) :: zwork ! 1D workspace305 INTEGER :: ijpjjpk 225 306 #endif 226 307 !!-------------------------------------------------------------------- 227 308 ! 309 #if defined key_mpp_mpi 310 IF(.NOT. wrk_use(1, 1))THEN 311 CALL ctl_stop('ptr_tjk: requested workspace array unavailable.') 312 RETURN 313 END IF 314 #endif 315 316 p_fval => p_fval2d 317 228 318 p_fval(:,:) = 0._wp 229 319 DO jk = 1, jpkm1 … … 235 325 END DO 236 326 #if defined key_mpp_mpi 327 ijpjjpk = jpj*jpk 237 328 ish(1) = jpj*jpk ; ish2(1) = jpj ; ish2(2) = jpk 238 zwork( :)= RESHAPE( p_fval, ish )239 CALL mpp_sum( zwork, jpj*jpk, ncomm_znl )329 zwork(1:ijpjjpk)= RESHAPE( p_fval, ish ) 330 CALL mpp_sum( zwork, ijpjjpk, ncomm_znl ) 240 331 p_fval(:,:)= RESHAPE( zwork, ish2 ) 241 332 #endif 242 333 ! 334 #if defined key_mpp_mpi 335 IF(.NOT. wrk_release(1, 1))THEN 336 CALL ctl_stop('ptr_tjk: failed to release workspace array.') 337 END IF 338 #endif 339 ! 243 340 END FUNCTION ptr_tjk 244 341 … … 250 347 USE oce, vt => ua ! use ua as workspace 251 348 USE oce, vs => ua ! use ua as workspace 349 IMPLICIT none 252 350 !! 253 351 INTEGER, INTENT(in) :: kt ! ocean time step index … … 388 486 IF( .NOT. ln_diaptr ) THEN ! diaptr not used 389 487 RETURN 390 ELSE ! Allocate the diaptr arrays391 ALLOCATE( btmsk(jpi,jpj,nptr) , &392 & htr_adv(jpj) , str_adv(jpj) , htr_ldf(jpj) , str_ldf(jpj) , htr_ove(jpj) , str_ove(jpj), &393 & htr(jpj,nptr) , str(jpj,nptr) , &394 & tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) , &395 & sjk (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr) , STAT=ierr )396 !397 IF( ierr > 0 ) THEN398 CALL ctl_stop( 'dia_ptr_init : unable to allocate standard arrays' ) ; RETURN399 ENDIF400 #if defined key_diaeiv401 !! IF( lk_diaeiv ) & ! eddy induced velocity arrays402 ALLOCATE( htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , v_msf_eiv(jpj,jpk,nptr) , STAT=ierr )403 !404 IF( ierr > 0 ) THEN405 CALL ctl_stop( 'dia_ptr_init : unable to allocate eiv arrays' ) ; RETURN406 ENDIF407 #endif408 488 ENDIF 409 489 … … 460 540 !! ** Method : NetCDF file 461 541 !!---------------------------------------------------------------------- 542 USE wrk_nemo, ONLY: wrk_use, wrk_release 543 USE wrk_nemo, ONLY: zphi => wrk_1d_1, zfoo => wrk_1d_2 544 USE wrk_nemo, ONLY: z_1 => wrk_2d_1 545 !! 462 546 INTEGER, INTENT(in) :: kt ! ocean time-step index 463 547 !! … … 466 550 INTEGER, SAVE :: ndim_atl_30 , ndim_pac_30 , ndim_ind_30 , ndim_ipc_30 467 551 INTEGER, SAVE :: ndim_h, ndim_h_atl_30, ndim_h_pac_30, ndim_h_ind_30, ndim_h_ipc_30 468 INTEGER, SAVE, DIMENSION (jpj*jpk) :: ndex , ndex_atl , ndex_pac , ndex_ind , ndex_ipc469 INTEGER, SAVE, DIMENSION (jpj*jpk) :: ndex_atl_30 , ndex_pac_30 , ndex_ind_30 , ndex_ipc_30470 INTEGER, SAVE, DIMENSION (jpj) :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30471 552 !! 472 553 CHARACTER (len=40) :: clhstnam, clop, clop_once, cl_comment ! temporary names … … 476 557 #endif 477 558 REAL(wp) :: zsto, zout, zdt, zjulian ! temporary scalars 478 REAL(wp), DIMENSION(jpj) :: zphi, zfoo 479 REAL(wp), DIMENSION(jpj,jpk) :: z_1 480 !!---------------------------------------------------------------------- 559 !!---------------------------------------------------------------------- 560 561 IF( (.not. wrk_use(1, 1,2)) .OR. (.not. wrk_use(2, 1)) )THEN 562 CALL ctl_stop('dia_ptr_wri: ERROR: requested workspace arrays unavailable') 563 RETURN 564 END IF 481 565 482 566 ! define time axis … … 507 591 IF( jp_cfg == 2 ) iline = 48 ! i-line that passes near the North Pole 508 592 IF( jp_cfg == 4 ) iline = 24 ! i-line that passes near the North Pole 509 zphi( :) = 0._wp593 zphi(1:jpj) = 0._wp 510 594 DO ji = mi0(iline), mi1(iline) 511 zphi( :) = gphiv(ji,:) ! if iline is in the local domain595 zphi(1:jpj) = gphiv(ji,:) ! if iline is in the local domain 512 596 ! Correct highest latitude for some configurations - will work if domain is parallelized in J ? 513 597 IF( jp_cfg == 05 ) THEN … … 533 617 ELSE ! OTHER configurations 534 618 ! ! ======================= 535 zphi( :) = gphiv(1,:) ! assume lat/lon coordinate, select the first i-line619 zphi(1:jpj) = gphiv(1,:) ! assume lat/lon coordinate, select the first i-line 536 620 ! 537 621 ENDIF … … 555 639 556 640 zout = nn_fwri * zdt 557 zfoo( :) = 0._wp641 zfoo(1:jpj) = 0._wp 558 642 559 643 ! Compute julian date from starting date of the run … … 802 886 ENDIF 803 887 ! 804 END SUBROUTINE dia_ptr_wri 888 IF( (.not. wrk_release(1, 1,2)) .OR. (.not. wrk_release(2, 1)) )THEN 889 CALL ctl_stop('dia_ptr_wri: ERROR: failed to release workspace arrays') 890 END IF 891 ! 892 END SUBROUTINE dia_ptr_wri 805 893 806 894 !!====================================================================== -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r2561 r2590 54 54 PUBLIC dia_wri ! routines called by step.F90 55 55 PUBLIC dia_wri_state 56 PUBLIC dia_wri_alloc ! Called by nemogcm module 56 57 57 58 INTEGER :: nid_T, nz_T, nh_T, ndim_T, ndim_hT ! grid_T file … … 60 61 INTEGER :: nid_W, nz_W, nh_W ! grid_W file 61 62 INTEGER :: ndex(1) ! ??? 62 INTEGER, DIMENSION(jpi*jpj) ::ndex_hT, ndex_hU, ndex_hV63 INTEGER, DIMENSION(jpi*jpj*jpk) ::ndex_T, ndex_U, ndex_V63 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV 64 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V 64 65 65 66 !! * Substitutions … … 73 74 !!---------------------------------------------------------------------- 74 75 CONTAINS 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 92 END FUNCTION dia_wri_alloc 75 93 76 94 #if defined key_dimgout … … 98 116 !!---------------------------------------------------------------------- 99 117 USE oce, ONLY : z3d => ta ! use ta as 3D workspace 118 USE wrk_nemo, ONLY: wrk_use, wrk_release 119 USE wrk_nemo, ONLY: z2d => wrk_2d_1 100 120 !! 101 121 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 103 123 INTEGER :: ji, jj, jk ! dummy loop indices 104 124 REAL(wp) :: zztmp, zztmpx, zztmpy ! 105 REAL(wp), DIMENSION(jpi,jpj) :: z2d !106 125 !!---------------------------------------------------------------------- 107 126 ! 127 IF( .not. wrk_use(2, 1))THEN 128 CALL ctl_stop('dia_wri: ERROR - requested 2D workspace unavailable.') 129 RETURN 130 END IF 131 ! 108 132 ! Output the initial state and forcings 109 133 IF( ninist == 1 ) THEN … … 175 199 ENDIF 176 200 ! 201 IF( .not. wrk_release(2, 1))THEN 202 CALL ctl_stop('dia_wri: ERROR - failed to release 2D workspace.') 203 RETURN 204 END IF 205 ! 177 206 END SUBROUTINE dia_wri 178 207 … … 194 223 !! Each nwrite time step, output the instantaneous or mean fields 195 224 !!---------------------------------------------------------------------- 225 USE wrk_nemo, ONLY: wrk_use, wrk_release 226 USE wrk_nemo, ONLY: zw2d => wrk_2d_1 227 !! 196 228 INTEGER, INTENT( in ) :: kt ! ocean time-step index 197 229 !! … … 201 233 INTEGER :: iimi, iima, ipk, it, itmod, ijmi, ijma ! local integers 202 234 REAL(wp) :: zsto, zout, zmax, zjulian, zdt ! local scalars 203 REAL(wp), DIMENSION(jpi,jpj) :: zw2d ! 2D workspace204 235 !!---------------------------------------------------------------------- 236 ! 237 IF( .not. wrk_use(2, 1))THEN 238 CALL ctl_stop('dia_wri: ERROR - requested 2D workspace unavailable.') 239 RETURN 240 END IF 205 241 ! 206 242 ! Output the initial state and forcings … … 571 607 ENDIF 572 608 ! 609 IF( .not. wrk_release(2, 1))THEN 610 CALL ctl_stop('dia_wri: ERROR - failed to release 2D workspace.') 611 RETURN 612 END IF 613 ! 573 614 END SUBROUTINE dia_wri 574 615 # endif -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90
r2528 r2590 79 79 #endif 80 80 81 REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) :: um , vm ! used to compute mean u, v fields82 REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) :: wm ! used to compute mean w fields83 REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) :: avtm ! used to compute mean kz fields84 REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) :: tm , sm ! used to compute mean t, s fields85 REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) :: fsel ! used to compute mean 2d fields81 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 86 86 REAL(wp) :: zdtj 87 87 ! … … 95 95 ! --------------- 96 96 ! 97 IF(.not.ALLOCATED(um))THEN 98 ALLOCATE(um(jpi,jpj,jpk), vm(jpi,jpj,jpk), & 99 wm(jpi,jpj,jpk), & 100 avtm(jpi,jpj,jpk), & 101 tm(jpi,jpj,jpk), sm(jpi,jpj,jpk), & 102 fsel(jpi,jpj,jpk), & 103 Stat=jk) 104 IF(jk /= 0)THEN 105 WRITE(*,*) 'ERROR: allocate failed in dia_wri (diawri_dimg.h90)' 106 CALL mppabort() 107 END IF 108 END IF 109 97 110 inbsel = 17 98 111 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r2528 r2590 49 49 INTEGER , PUBLIC :: neuler = 0 !: restart euler forward option (0=Euler) 50 50 REAL(wp), PUBLIC :: atfp1 !: asselin time filter coeff. (atfp1= 1-2*atfp) 51 REAL(wp), PUBLIC, DIMENSION(jpk) :: rdttra!: vertical profile of tracer time step51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdttra !: vertical profile of tracer time step 52 52 53 53 ! !!* Namelist namcla : cross land advection … … 83 83 INTEGER, PUBLIC :: nidom !: ??? 84 84 85 INTEGER, PUBLIC, DIMENSION(jpi):: mig !: local ==> global domain i-index86 INTEGER, PUBLIC, DIMENSION(jpj):: mjg !: local ==> global domain j-index87 INTEGER, PUBLIC, DIMENSION(jpidta) :: mi0, mi1 !: global ==> local domain i-index !!bug ==> other solution?85 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mig !: local ==> global domain i-index 86 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mjg !: local ==> global domain j-index 87 INTEGER, PUBLIC, DIMENSION(jpidta) :: mi0, mi1 !: global ==> local domain i-index !!bug ==> other solution? 88 88 ! ! (mi0=1 and mi1=0 if the global index is not in the local domain) 89 INTEGER, PUBLIC, DIMENSION(jpjdta) :: mj0, mj1 !: global ==> local domain j-index !!bug ==> other solution?89 INTEGER, PUBLIC, DIMENSION(jpjdta) :: mj0, mj1 !: global ==> local domain j-index !!bug ==> other solution? 90 90 ! ! (mi0=1 and mi1=0 if the global index is not in the local domain) 91 INTEGER, PUBLIC, DIMENSION(jpnij):: nimppt, njmppt !: i-, j-indexes for each processor92 INTEGER, PUBLIC, DIMENSION(jpnij):: ibonit, ibonjt !: i-, j- processor neighbour existence93 INTEGER, PUBLIC, DIMENSION(jpnij):: nlcit , nlcjt !: dimensions of every subdomain94 INTEGER, PUBLIC, DIMENSION(jpnij):: nldit , nldjt !: first, last indoor index for each i-domain95 INTEGER, PUBLIC, DIMENSION(jpnij):: nleit , nlejt !: first, last indoor index for each j-domain91 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nimppt, njmppt !: i-, j-indexes for each processor 92 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ibonit, ibonjt !: i-, j- processor neighbour existence 93 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nlcit , nlcjt !: dimensions of every subdomain 94 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nldit , nldjt !: first, last indoor index for each i-domain 95 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nleit , nlejt !: first, last indoor index for each j-domain 96 96 97 97 !!---------------------------------------------------------------------- 98 98 !! horizontal curvilinear coordinate and scale factors 99 99 !! --------------------------------------------------------------------- 100 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::glamt, glamu !: longitude of t-, u-, v- and f-points (degre)101 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::glamv, glamf !:102 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::gphit, gphiu !: latitude of t-, u-, v- and f-points (degre)103 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::gphiv, gphif !:104 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::e1t, e2t !: horizontal scale factors at t-point (m)105 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::e1u, e2u !: horizontal scale factors at u-point (m)106 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::e1v, e2v !: horizontal scale factors at v-point (m)107 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::e1f, e2f !: horizontal scale factors at f-point (m)108 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::ff !: coriolis factor (2.*omega*sin(yphi) ) (s-1)100 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: glamt, glamu !: longitude of t-, u-, v- and f-points (degre) 101 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: glamv, glamf !: 102 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gphit, gphiu !: latitude of t-, u-, v- and f-points (degre) 103 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gphiv, gphif !: 104 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1t, e2t !: horizontal scale factors at t-point (m) 105 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1u, e2u !: horizontal scale factors at u-point (m) 106 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1v, e2v !: horizontal scale factors at v-point (m) 107 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1f, e2f !: horizontal scale factors at f-point (m) 108 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ff !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 109 109 110 110 !!---------------------------------------------------------------------- … … 118 118 !! All coordinates 119 119 !! --------------- 120 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: gdep3w !: depth of T-points (sum of e3w) (m)121 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: gdept , gdepw !: analytical depth at T-W points (m)122 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3v , e3f !: analytical vertical scale factors at V--F123 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3t , e3u !: T--U points (m)124 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3vw !: analytical vertical scale factors at VW--125 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3w , e3uw !: W--UW points (m)120 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdep3w !: depth of T-points (sum of e3w) (m) 121 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept , gdepw !: analytical depth at T-W points (m) 122 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3v , e3f !: analytical vertical scale factors at V--F 123 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t , e3u !: T--U points (m) 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw !: analytical vertical scale factors at VW-- 125 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w , e3uw !: W--UW points (m) 126 126 #if defined key_vvl 127 127 LOGICAL, PUBLIC, PARAMETER :: lk_vvl = .TRUE. !: variable grid flag … … 129 129 !! All coordinates 130 130 !! --------------- 131 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: gdep3w_1 !: depth of T-points (sum of e3w) (m)132 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: gdept_1, gdepw_1 !: analytical depth at T-W points (m)133 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3v_1 , e3f_1 !: analytical vertical scale factors at V--F134 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3t_1 , e3u_1 !: T--U points (m)135 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3vw_1 !: analytical vertical scale factors at VW--136 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3w_1 , e3uw_1 !: W--UW points (m)137 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3t_b !: before - - - - T points (m)138 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3u_b , e3v_b !: - - - - - U--V points (m)131 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdep3w_1 !: depth of T-points (sum of e3w) (m) 132 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_1, gdepw_1 !: analytical depth at T-W points (m) 133 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3v_1 , e3f_1 !: analytical vertical scale factors at V--F 134 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_1 , e3u_1 !: T--U points (m) 135 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw_1 !: analytical vertical scale factors at VW-- 136 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w_1 , e3uw_1 !: W--UW points (m) 137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_b !: before - - - - T points (m) 138 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3u_b , e3v_b !: - - - - - U--V points (m) 139 139 #else 140 140 LOGICAL, PUBLIC, PARAMETER :: lk_vvl = .FALSE. !: fixed grid flag 141 141 #endif 142 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hur , hvr !: inverse of u and v-points ocean depth (1/m)143 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hu , hv !: depth at u- and v-points (meters)144 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hu_0 , hv_0 !: refernce depth at u- and v-points (meters)142 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur , hvr !: inverse of u and v-points ocean depth (1/m) 143 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu , hv !: depth at u- and v-points (meters) 144 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 , hv_0 !: refernce depth at u- and v-points (meters) 145 145 146 146 INTEGER, PUBLIC :: nla10 !: deepest W level Above ~10m (nlb10 - 1) … … 149 149 !! z-coordinate with full steps (also used in the other cases as reference z-coordinate) 150 150 !! =-----------------====------ 151 REAL(wp), PUBLIC, DIMENSION(jpk) :: gdept_0, gdepw_0!: reference depth of t- and w-points (m)152 REAL(wp), PUBLIC, DIMENSION(jpk) :: e3t_0 , e3w_0!: reference vertical scale factors at T- and W-pts (m)153 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: e3tp , e3wp!: ocean bottom level thickness at T and W points151 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gdept_0, gdepw_0 !: reference depth of t- and w-points (m) 152 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: e3t_0 , e3w_0 !: reference vertical scale factors at T- and W-pts (m) 153 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e3tp , e3wp !: ocean bottom level thickness at T and W points 154 154 155 155 !! s-coordinate and hybrid z-s-coordinate 156 156 !! =----------------======--------------- 157 REAL(wp), PUBLIC, DIMENSION(jpk) :: gsigt, gsigw !: model level depth coefficient at t-, w-levels (analytic)158 REAL(wp), PUBLIC, DIMENSION(jpk) :: gsi3w !: model level depth coefficient at w-level (sum of gsigw)159 REAL(wp), PUBLIC, DIMENSION(jpk) :: esigt, esigw !: vertical scale factor coef. at t-, w-levels160 161 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hbatv , hbatf !: ocean depth at the vertical of V--F162 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hbatt , hbatu !: T--U points (m)163 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: scosrf, scobot !: ocean surface and bottom topographies164 ! 165 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hifv , hiff !: interface depth between stretching at V--F166 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hift , hifu !: and quasi-uniform spacing T--U points (m)157 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gsigt, gsigw !: model level depth coefficient at t-, w-levels (analytic) 158 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gsi3w !: model level depth coefficient at w-level (sum of gsigw) 159 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: esigt, esigw !: vertical scale factor coef. at t-, w-levels 160 161 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hbatv , hbatf !: ocean depth at the vertical of V--F 162 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hbatt , hbatu !: T--U points (m) 163 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: scosrf, scobot !: ocean surface and bottom topographies 164 ! ! (if deviating from coordinate surfaces in HYBRID) 165 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hifv , hiff !: interface depth between stretching at V--F 166 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hift , hifu !: and quasi-uniform spacing T--U points (m) 167 167 168 168 !!---------------------------------------------------------------------- 169 169 !! masks, bathymetry 170 170 !! --------------------------------------------------------------------- 171 INTEGER , PUBLIC, DIMENSION(jpi,jpj) :: mbathy !: number of ocean level (=0, 1, ... , jpk-1)172 INTEGER , PUBLIC, DIMENSION(jpi,jpj) :: mbkt !: vertical index of the bottom last T- ocean level173 INTEGER , PUBLIC, DIMENSION(jpi,jpj) :: mbku, mbkv !: vertical index of the bottom last U- and W- ocean level174 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: bathy !: ocean depth (meters)175 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tmask_i !: interior domain T-point mask176 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: bmask !: land/ocean mask of barotropic stream function177 178 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::tmask, umask, vmask, fmask !: land/ocean mask at T-, U-, V- and F-pts171 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbathy !: number of ocean level (=0, 1, ... , jpk-1) 172 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt !: vertical index of the bottom last T- ocean level 173 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbku, mbkv !: vertical index of the bottom last U- and W- ocean level 174 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bathy !: ocean depth (meters) 175 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_i !: interior domain T-point mask 176 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bmask !: land/ocean mask of barotropic stream function 177 178 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tmask, umask, vmask, fmask !: land/ocean mask at T-, U-, V- and F-pts 179 179 180 180 REAL(wp), PUBLIC, DIMENSION(jpiglo) :: tpol, fpol !: north fold mask (jperio= 3 or 4) 181 181 182 182 #if defined key_noslip_accurate 183 INTEGER, PUBLIC, DIMENSION (4,jpk) :: npcoa!: ???184 INTEGER, PUBLIC, DIMENSION(2*(jpi+jpj),4,jpk) :: nicoa, njcoa!: ???183 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,: ) :: npcoa !: ??? 184 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nicoa, njcoa !: ??? 185 185 #endif 186 186 … … 215 215 LOGICAL, PUBLIC, PARAMETER :: lk_mpp_rep = .FALSE. !: agrif flag 216 216 #endif 217 218 PUBLIC dom_oce_alloc ! Called from nemogcm.F90 219 217 220 !!---------------------------------------------------------------------- 218 221 !! agrif domain … … 222 225 #else 223 226 LOGICAL, PUBLIC, PARAMETER :: lk_agrif = .FALSE. !: agrif flag 227 #endif 224 228 225 229 CONTAINS 230 231 #if ! defined key_agrif 226 232 LOGICAL FUNCTION Agrif_Root() 227 233 Agrif_Root = .TRUE. … … 232 238 END FUNCTION Agrif_CFixed 233 239 #endif 240 241 FUNCTION dom_oce_alloc() 242 !!---------------------------------------------------------------------- 243 USE par_oce, Only: jpi, jpj, jpk, jpnij 244 IMPLICIT none 245 INTEGER :: dom_oce_alloc 246 INTEGER, DIMENSION(11) :: ierr 247 248 ierr(:) = 0 249 250 ALLOCATE(rdttra(jpk), mig(jpi), mjg(jpj), Stat=ierr(1)) 251 252 ALLOCATE(nimppt(jpnij), njmppt(jpnij), & 253 ibonit(jpnij), ibonjt(jpnij), & 254 nlcit(jpnij), nlcjt(jpnij), & 255 nldit(jpnij), nldjt(jpnij), & 256 nleit(jpnij), nlejt(jpnij), Stat=ierr(2)) 257 258 ALLOCATE(glamt(jpi,jpj), glamu(jpi,jpj), & 259 glamv(jpi,jpj), glamf(jpi,jpj), & 260 gphit(jpi,jpj), gphiu(jpi,jpj), & 261 gphiv(jpi,jpj), gphif(jpi,jpj), & 262 e1t(jpi,jpj), e2t(jpi,jpj), & 263 e1u(jpi,jpj), e2u(jpi,jpj), & 264 e1v(jpi,jpj), e2v(jpi,jpj), & 265 e1f(jpi,jpj), e2f(jpi,jpj), & 266 ff(jpi,jpj), Stat=ierr(3)) 267 268 !IF( .not. lk_zco )THEN 269 ALLOCATE(gdep3w(jpi,jpj,jpk), & 270 gdept(jpi,jpj,jpk) , gdepw(jpi,jpj,jpk), & 271 e3v(jpi,jpj,jpk) , e3f(jpi,jpj,jpk) , & 272 e3t(jpi,jpj,jpk) , e3u(jpi,jpj,jpk) , & 273 e3vw(jpi,jpj,jpk) , & 274 e3w(jpi,jpj,jpk) , e3uw(jpi,jpj,jpk) , Stat=ierr(4)) 275 !END IF 276 277 #if defined key_vvl 278 ALLOCATE(gdep3w_1(jpi,jpj,jpk) , & 279 gdept_1(jpi,jpj,jpk), gdepw_1(jpi,jpj,jpk), & 280 e3v_1(jpi,jpj,jpk) , e3f_1(jpi,jpj,jpk) , & 281 e3t_1(jpi,jpj,jpk) , e3u_1(jpi,jpj,jpk) , & 282 e3vw_1(jpi,jpj,jpk) , & 283 e3w_1(jpi,jpj,jpk) , e3uw_1(jpi,jpj,jpk), & 284 e3t_b(jpi,jpj,jpk) , & 285 e3u_b(jpi,jpj,jpk) , e3v_b(jpi,jpj,jpk), & 286 Stat=ierr(5)) 287 #endif 288 289 ALLOCATE(hur(jpi,jpj), hvr(jpi,jpj), & 290 hu(jpi,jpj), hv(jpi,jpj), & 291 hu_0(jpi,jpj), hv_0(jpi,jpj),& 292 Stat=ierr(6)) 293 ! 294 ALLOCATE(gdept_0(jpk), gdepw_0(jpk), e3t_0(jpk), & 295 e3w_0(jpk) , e3tp(jpi,jpj), e3wp(jpi,jpj), & 296 gsigt(jpk) , gsigw(jpk) , gsi3w(jpk), & 297 esigt(jpk) , esigw(jpk) , Stat=ierr(7)) 298 ! 299 ALLOCATE(hbatv(jpi,jpj) , hbatf(jpi,jpj) , & 300 hbatt(jpi,jpj) , hbatu(jpi,jpj) , & 301 scosrf(jpi,jpj), scobot(jpi,jpj), & 302 hifv(jpi,jpj) , hiff(jpi,jpj) , & 303 hift(jpi,jpj) , hifu(jpi,jpj) , & 304 Stat=ierr(8)) 305 ! 306 ALLOCATE(mbathy(jpi,jpj), & 307 mbkt(jpi,jpj), mbku(jpi,jpj), mbkv(jpi,jpj), & 308 bathy(jpi,jpj), & 309 tmask_i(jpi,jpj),bmask(jpi,jpj), & 310 Stat=ierr(9)) 311 312 ALLOCATE(tmask(jpi,jpj,jpk), umask(jpi,jpj,jpk), & 313 vmask(jpi,jpj,jpk), fmask(jpi,jpj,jpk), & 314 Stat=ierr(10)) 315 316 #if defined key_noslip_accurate 317 ALLOCATE(npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), & 318 Stat=ierr(11)) 319 #endif 320 321 dom_oce_alloc = MAXVAL(ierr) 322 323 END FUNCTION dom_oce_alloc 324 234 325 !!---------------------------------------------------------------------- 235 326 !! NEMO/OPA 3.3 , NEMO Consortium (2010) -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r2528 r2590 34 34 PRIVATE 35 35 36 PUBLIC dom_msk ! routine called by inidom.F90 36 PUBLIC dom_msk ! routine called by inidom.F90 37 PUBLIC dom_msk_alloc ! routine called by nemogcm.F90 37 38 38 39 ! !!* Namelist namlbc : lateral boundary condition * 39 40 REAL(wp) :: rn_shlat = 2. ! type of lateral boundary condition on velocity 40 41 42 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:,:) :: icoord ! Workspace for dom_msk_nsa() 43 41 44 !! * Substitutions 42 45 # include "vectopt_loop_substitute.h90" … … 48 51 CONTAINS 49 52 53 FUNCTION dom_msk_alloc() 54 !!--------------------------------------------------------------------- 55 !! *** ROUTINE dom_msk_alloc *** 56 !!--------------------------------------------------------------------- 57 INTEGER :: dom_msk_alloc 58 59 dom_msk_alloc = 0 60 61 #if defined key_noslip_accurate 62 ALLOCATE(icoord(jpi*jpj*jpk,3), Stat=dom_msk_alloc) 63 #endif 64 65 IF(dom_msk_alloc /= 0)THEN 66 CALL ctl_warn('dom_msk_alloc: failed to allocate icoord array.') 67 END IF 68 69 END FUNCTION dom_msk_alloc 70 71 50 72 SUBROUTINE dom_msk 51 73 !!--------------------------------------------------------------------- … … 109 131 !! tmask_i : interior ocean mask 110 132 !!---------------------------------------------------------------------- 133 USE wrk_nemo, ONLY: wrk_use, wrk_release, iwrk_use, iwrk_release 134 USE wrk_nemo, ONLY: zwf => wrk_2d_1 135 USE wrk_nemo, ONLY: imsk => iwrk_2d_1 136 !! 111 137 INTEGER :: ji, jj, jk ! dummy loop indices 112 138 INTEGER :: iif, iil, ii0, ii1, ii 113 139 INTEGER :: ijf, ijl, ij0, ij1 114 INTEGER , DIMENSION(jpi,jpj) :: imsk115 REAL(wp), DIMENSION(jpi,jpj) :: zwf116 140 !! 117 141 NAMELIST/namlbc/ rn_shlat 118 142 !!--------------------------------------------------------------------- 119 143 144 IF( (.not. wrk_use(2,1)) .OR. (.not. iwrk_use(2,1)) )THEN 145 CALL ctl_stop('dom_msk: ERROR: requested workspace arrays unavailable.') 146 RETURN 147 END IF 148 120 149 REWIND( numnam ) ! Namelist namlbc : lateral momentum boundary condition 121 150 READ ( numnam, namlbc ) … … 414 443 ENDIF 415 444 ! 445 IF( (.not. wrk_release(2,1)) .OR. (.not. iwrk_release(2,1)) )THEN 446 CALL ctl_stop('dom_msk: ERROR: failed to release workspace arrays.') 447 END IF 448 ! 416 449 END SUBROUTINE dom_msk 417 450 … … 434 467 INTEGER :: ine, inw, ins, inn, itest, ierror, iind, ijnd 435 468 REAL(wp) :: zaa 436 INTEGER, DIMENSION(jpi*jpj*jpk,3) :: icoord437 469 !!--------------------------------------------------------------------- 438 470 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90
r2528 r2590 36 36 !! 37 37 !!---------------------------------------------------------------------- 38 USE in_out_manager, ONLY: ctl_stop 39 USE wrk_nemo, ONLY: wrk_use, wrk_release 40 USE wrk_nemo, ONLY: zglam => wrk_2d_2, & 41 zgphi => wrk_2d_3, & 42 zmask => wrk_2d_4, & 43 zdist => wrk_2d_5 44 IMPLICIT none 38 45 REAL(wp) , INTENT(in ) :: plon, plat ! longitude,latitude of the point 39 46 INTEGER , INTENT( out) :: kii, kjj ! i-,j-index of the closes grid point … … 41 48 !! 42 49 INTEGER , DIMENSION(2) :: iloc 43 REAL(wp), DIMENSION(jpi,jpj) :: zglam, zgphi, zmask, zdist44 50 REAL(wp) :: zlon 45 51 REAL(wp) :: zmini 46 52 !!-------------------------------------------------------------------- 47 53 54 IF(.not. wrk_use(2, 2, 3, 4, 5))THEN 55 CALL ctl_stop('dom_ngb: Requested workspaces already in use.') 56 END IF 57 48 58 zmask(:,:) = 0. 49 59 SELECT CASE( cdgrid ) … … 71 81 ENDIF 72 82 83 IF(.not. wrk_release(2, 2,3,4,5))THEN 84 CALL ctl_stop('dom_ngb: error releasing workspaces.') 85 ENDIF 86 73 87 END SUBROUTINE dom_ngb 74 88 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r2528 r2590 24 24 PRIVATE 25 25 26 PUBLIC dom_vvl ! called by domain.F90 27 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ee_t, ee_u, ee_v, ee_f !: ??? 29 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: mut, muu, muv, muf !: ??? 30 31 REAL(wp), DIMENSION(jpk) :: r2dt ! vertical profile time-step, = 2 rdttra 26 PUBLIC dom_vvl ! called by domain.F90 27 PUBLIC dom_vvl_alloc ! called by nemogcm.F90 28 29 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ee_t, ee_u, ee_v, ee_f !: ??? 30 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mut, muu, muv, muf !: ??? 31 32 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra 32 33 ! ! except at nit000 (=rdttra) if neuler=0 33 34 … … 42 43 43 44 CONTAINS 45 46 FUNCTION dom_vvl_alloc() 47 !!---------------------------------------------------------------------- 48 !! *** ROUTINE dom_vvl_alloc *** 49 !!---------------------------------------------------------------------- 50 IMPLICIT none 51 INTEGER :: dom_vvl_alloc 52 !!---------------------------------------------------------------------- 53 54 ALLOCATE(mut(jpi,jpj,jpk), muu(jpi,jpj,jpk), muv(jpi,jpj,jpk), & 55 muf(jpi,jpj,jpk), & 56 ee_t(jpi,jpj), ee_u(jpi,jpj), ee_v(jpi,jpj), ee_f(jpi,jpj), & 57 r2dt(jpk), Stat=dom_vvl_alloc) 58 59 IF(dom_vvl_alloc /= 0)THEN 60 CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays') 61 END IF 62 63 END FUNCTION dom_vvl_alloc 64 44 65 45 66 SUBROUTINE dom_vvl … … 50 71 !! ssh over the whole water column (scale factors) 51 72 !!---------------------------------------------------------------------- 73 USE wrk_nemo, ONLY: wrk_use, wrk_release 74 USE wrk_nemo, ONLY: zs_t => wrk_2d_1, zs_u_1 => wrk_2d_2, & 75 zs_v_1 => wrk_2d_3 76 !! 52 77 INTEGER :: ji, jj, jk 53 78 REAL(wp) :: zcoefu , zcoefv , zcoeff ! temporary scalars 54 79 REAL(wp) :: zv_t_ij, zv_t_ip1j, zv_t_ijp1, zv_t_ip1jp1 ! - - 55 REAL(wp), DIMENSION(jpi,jpj) :: zs_t, zs_u_1, zs_v_1 ! - 2D workspace 56 !!---------------------------------------------------------------------- 80 !!---------------------------------------------------------------------- 81 82 IF(.not. wrk_use(2, 1,2,3))THEN 83 CALL ctl_stop('dom_vvl: ERROR - requested workspace arrays unavailable.') 84 RETURN 85 END IF 57 86 58 87 IF(lwp) THEN … … 167 196 fse3v_b(:,:,:) = fse3v_b(:,:,:) + fse3v_0(:,:,:) 168 197 ! 198 IF(.not. wrk_release(2, 1,2,3))THEN 199 CALL ctl_stop('dom_vvl: ERROR - failed to release workspace arrays.') 200 END IF 201 ! 169 202 END SUBROUTINE dom_vvl 170 203 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
r2528 r2590 25 25 26 26 PUBLIC dom_wri ! routine called by inidom.F90 27 PUBLIC dom_wri_alloc ! routine called by nemogcm.F90 28 29 LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: lldbl ! Used in dom_uniq to store whether each point is unique or not 27 30 28 31 !! * Substitutions … … 34 37 !!---------------------------------------------------------------------- 35 38 CONTAINS 39 40 FUNCTION dom_wri_alloc() 41 !!---------------------------------------------------------------------- 42 !! *** ROUTINE dom_wri_alloc *** 43 !!---------------------------------------------------------------------- 44 INTEGER :: dom_wri_alloc 45 !!---------------------------------------------------------------------- 46 47 ALLOCATE(lldbl(jpi,jpj,1), Stat = dom_wri_alloc) 48 49 END FUNCTION dom_wri_alloc 50 36 51 37 52 SUBROUTINE dom_wri … … 63 78 !! masks, depth and vertical scale factors 64 79 !!---------------------------------------------------------------------- 80 USE wrk_nemo, ONLY: wrk_use, wrk_release 81 USE wrk_nemo, ONLY: zprt => wrk_2d_1, zprw => wrk_2d_2 82 USE wrk_nemo, ONLY: zdepu => wrk_3d_1, zdepv => wrk_3d_2 83 !! 65 84 INTEGER :: inum0 ! temprary units for 'mesh_mask.nc' file 66 85 INTEGER :: inum1 ! temprary units for 'mesh.nc' file … … 74 93 CHARACTER(len=21) :: clnam4 ! filename (vertical mesh informations) 75 94 INTEGER :: ji, jj, jk ! dummy loop indices 76 REAL(wp), DIMENSION(jpi,jpj) :: zprt , zprw ! 2D workspace 77 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepu, zdepv ! 3D workspace 78 !!---------------------------------------------------------------------- 95 !!---------------------------------------------------------------------- 96 97 IF( (.not. wrk_use(2, 1,2)) .OR. (.not. wrk_use(3, 1,2)) )THEN 98 CALL ctl_stop('dom_wri: ERROR - requested workspace arrays unavailable.') 99 RETURN 100 END IF 79 101 80 102 IF(lwp) WRITE(numout,*) … … 122 144 CALL iom_rstput( 0, 0, inum2, 'fmask', fmask, ktype = jp_i1 ) 123 145 124 125 zprt = tmask(:,:,1) * dom_uniq('T')! ! unique point mask146 CALL dom_uniq(zprw, 'T') 147 zprt = tmask(:,:,1) * zprw ! ! unique point mask 126 148 CALL iom_rstput( 0, 0, inum2, 'tmaskutil', zprt, ktype = jp_i1 ) 127 zprt = umask(:,:,1) * dom_uniq('U') 149 CALL dom_uniq(zprw, 'U') 150 zprt = umask(:,:,1) * zprw 128 151 CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 ) 129 zprt = vmask(:,:,1) * dom_uniq('V') 152 CALL dom_uniq(zprw, 'V') 153 zprt = vmask(:,:,1) * zprw 130 154 CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 ) 131 zprt = fmask(:,:,1) * dom_uniq('F') 155 CALL dom_uniq(zprw, 'F') 156 zprt = fmask(:,:,1) * zprw 132 157 CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 ) 133 158 … … 251 276 END SELECT 252 277 ! 278 IF( (.not. wrk_release(2, 1,2)) .OR. (.not. wrk_release(3, 1,2)) )THEN 279 CALL ctl_stop('dom_wri: ERROR - failed to release workspace arrays.') 280 END IF 281 ! 253 282 END SUBROUTINE dom_wri 254 283 255 284 256 FUNCTION dom_uniq( cdgrd ) RESULT( puniq)285 SUBROUTINE dom_uniq(puniq, cdgrd ) 257 286 !!---------------------------------------------------------------------- 258 287 !! *** ROUTINE dom_uniq *** … … 263 292 !! 2) check which elements have been changed 264 293 !!---------------------------------------------------------------------- 294 !! 295 USE wrk_nemo, ONLY: wrk_use, wrk_release 296 USE wrk_nemo, ONLY: ztstref => wrk_2d_1 ! array with different values for each element 297 !! 265 298 CHARACTER(len=1) , INTENT(in ) :: cdgrd ! 266 REAL(wp), DIMENSION(jpi,jpj) :: puniq ! 267 ! 268 REAL(wp), DIMENSION(jpi,jpj ) :: ztstref ! array with different values for each element 299 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: puniq ! 300 ! 269 301 REAL(wp) :: zshift ! shift value link to the process number 270 LOGICAL , DIMENSION(jpi,jpj,1) :: lldbl ! is the point unique or not?271 302 INTEGER :: ji ! dummy loop indices 272 303 !!---------------------------------------------------------------------- 273 ! 304 305 IF(.not. wrk_use(2, 1))THEN 306 CALL ctl_stop('dom_uniq: ERROR - requested workspace array unavailable.') 307 RETURN 308 END IF 309 274 310 ! build an array with different values for each element 275 311 ! in mpp: make sure that these values are different even between process … … 286 322 puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp ) 287 323 ! 288 END FUNCTIONdom_uniq324 END SUBROUTINE dom_uniq 289 325 290 326 !!====================================================================== -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r2536 r2590 42 42 PRIVATE 43 43 44 PUBLIC dom_zgr ! called by dom_init.F90 44 PUBLIC dom_zgr ! called by dom_init.F90 45 PUBLIC dom_zgr_alloc ! called by nemo_alloc in nemogcm.F90 45 46 46 47 ! !!* Namelist namzgr_sco * … … 54 55 ! ! ( rn_bb=0; top only, rn_bb =1; top and bottom) 55 56 REAL(wp) :: rn_hc = 150._wp ! Critical depth for s-sigma coordinates 56 57 58 !! Arrays used in zgr_sco 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gsigw3 60 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gsigt3 61 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gsi3w3 62 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: esigt3 63 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: esigw3 64 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: esigtu3 65 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: esigtv3 66 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: esigtf3 67 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: esigwu3 68 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: esigwv3 69 57 70 !! * Substitutions 58 71 # include "domzgr_substitute.h90" … … 64 77 !!---------------------------------------------------------------------- 65 78 CONTAINS 79 80 FUNCTION dom_zgr_alloc() 81 !!---------------------------------------------------------------------- 82 !! *** FUNCTION dom_zgr_alloc *** 83 !!---------------------------------------------------------------------- 84 INTEGER :: dom_zgr_alloc 85 !!---------------------------------------------------------------------- 86 87 ALLOCATE(gsigw3(jpi,jpj,jpk), gsigt3(jpi,jpj,jpk), & 88 esigt3(jpi,jpj,jpk), esigw3(jpi,jpj,jpk), & 89 esigtu3(jpi,jpj,jpk), esigtv3(jpi,jpj,jpk), & 90 esigtf3(jpi,jpj,jpk), esigwu3(jpi,jpj,jpk), & 91 esigwv3(jpi,jpj,jpk), Stat=dom_zgr_alloc) 92 93 IF(dom_zgr_alloc /= 0)THEN 94 CALL ctl_warn('dom_zgr_alloc: failed to allocate arrays.') 95 END IF 96 97 END FUNCTION dom_zgr_alloc 98 66 99 67 100 SUBROUTINE dom_zgr … … 586 619 !! - update bathy : meter bathymetry (in meters) 587 620 !!---------------------------------------------------------------------- 621 USE wrk_nemo, ONLY: wrk_use, wrk_release 622 USE wrk_nemo, ONLY: zbathy => wrk_2d_1 623 !! 588 624 INTEGER :: ji, jj, jl ! dummy loop indices 589 625 INTEGER :: icompt, ibtest, ikmax ! temporary integers 590 REAL(wp), DIMENSION(jpi,jpj) :: zbathy ! temporary workspace 591 !!---------------------------------------------------------------------- 626 !!---------------------------------------------------------------------- 627 628 IF(.not. wrk_use(2, 1))THEN 629 CALL ctl_stop('zgr_bat_ctl: ERROR: requested workspace array unavailable.') 630 RETURN 631 END IF 592 632 593 633 IF(lwp) WRITE(numout,*) … … 693 733 ENDIF 694 734 ! 735 IF(.not. wrk_release(2, 1))THEN 736 CALL ctl_stop('zgr_bat_ctl: ERROR: failed to release workspace array.') 737 RETURN 738 END IF 739 ! 695 740 END SUBROUTINE zgr_bat_ctl 696 741 … … 708 753 !! (min value = 1 over land) 709 754 !!---------------------------------------------------------------------- 755 USE wrk_nemo, ONLY: wrk_use, wrk_release 756 USE wrk_nemo, ONLY: zmbk => wrk_2d_1 757 !! 710 758 INTEGER :: ji, jj ! dummy loop indices 711 REAL(wp), DIMENSION(jpi,jpj) :: zmbk ! 2D workspace 712 !!---------------------------------------------------------------------- 759 !!---------------------------------------------------------------------- 760 ! 761 IF( .not. wrk_use(2, 1))THEN 762 CALL ctl_stop('zgr_bot_level: ERROR - requested 2D workspace unavailable.') 763 RETURN 764 END IF 713 765 ! 714 766 IF(lwp) WRITE(numout,*) … … 727 779 zmbk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk(zmbk,'U',1.) ; mbku (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 728 780 zmbk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk(zmbk,'V',1.) ; mbkv (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 781 ! 782 IF( .not. wrk_release(2, 1))THEN 783 CALL ctl_stop('zgr_bot_level: ERROR - failed to release workspace array.') 784 RETURN 785 END IF 729 786 ! 730 787 END SUBROUTINE zgr_bot_level … … 803 860 !! Reference : Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270. 804 861 !!---------------------------------------------------------------------- 862 USE wrk_nemo, ONLY: wrk_use, wrk_release 863 USE wrk_nemo, ONLY: zprt => wrk_3d_1 864 !! 805 865 INTEGER :: ji, jj, jk ! dummy loop indices 806 866 INTEGER :: ik, it ! temporary integers … … 811 871 REAL(wp) :: zdiff ! temporary scalar 812 872 REAL(wp) :: zrefdep ! temporary scalar 813 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprt ! 3D workspace814 873 !!--------------------------------------------------------------------- 874 ! 875 IF( .not. wrk_use(3, 1))THEN 876 CALL ctl_stop('zgr_zps: ERROR - requested workspace unavailable.') 877 RETURN 878 END IF 815 879 816 880 IF(lwp) WRITE(numout,*) … … 1004 1068 ENDIF 1005 1069 ! 1070 IF( .not. wrk_release(3, 1))THEN 1071 CALL ctl_stop('zgr_zps: ERROR - failed to release workspace.') 1072 RETURN 1073 END IF 1074 ! 1006 1075 END SUBROUTINE zgr_zps 1007 1076 … … 1090 1159 !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408. 1091 1160 !!---------------------------------------------------------------------- 1161 USE wrk_nemo, ONLY: wrk_use, wrk_release 1162 USE wrk_nemo, ONLY: zenv => wrk_2d_1, ztmp => wrk_2d_2, zmsk => wrk_2d_3, & 1163 zri => wrk_2d_4, zrj => wrk_2d_5, zhbat => wrk_2d_6 1164 !! 1092 1165 INTEGER :: ji, jj, jk, jl ! dummy loop argument 1093 1166 INTEGER :: iip1, ijp1, iim1, ijm1 ! temporary integers 1094 1167 REAL(wp) :: zcoeft, zcoefw, zrmax, ztaper ! temporary scalars 1095 REAL(wp), DIMENSION(jpi,jpj) :: zenv, ztmp, zmsk ! 2D workspace1096 REAL(wp), DIMENSION(jpi,jpj) :: zri , zrj , zhbat ! - -1097 !!1098 REAL(wp), DIMENSION(jpi,jpj,jpk) :: gsigw31099 REAL(wp), DIMENSION(jpi,jpj,jpk) :: gsigt31100 REAL(wp), DIMENSION(jpi,jpj,jpk) :: gsi3w31101 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigt31102 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigw31103 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigtu31104 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigtv31105 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigtf31106 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigwu31107 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigwv31108 1168 !! 1109 1169 NAMELIST/namzgr_sco/ rn_sbot_max, rn_sbot_min, rn_theta, rn_thetb, rn_rmax, ln_s_sigma, rn_bb, rn_hc 1110 1170 !!---------------------------------------------------------------------- 1171 1172 IF(.not. wrk_use(2, 1,2,3,4,5,6))THEN 1173 CALL ctl_stop('zgr_sco: ERROR - requested workspace arrays unavailable') 1174 RETURN 1175 END IF 1111 1176 1112 1177 REWIND( numnam ) ! Read Namelist namzgr_sco : sigma-stretching parameters … … 1551 1616 !!gm bug #endif 1552 1617 ! 1618 IF(.not. wrk_release(2, 1,2,3,4,5,6))THEN 1619 CALL ctl_stop('zgr_sco: ERROR - failed to release workspace arrays') 1620 END IF 1621 ! 1553 1622 END SUBROUTINE zgr_sco 1554 1623 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r2528 r2590 446 446 !! p=integral [ rau*g dz ] 447 447 !!---------------------------------------------------------------------- 448 USE wrk_nemo, ONLY: wrk_use, wrk_release 449 USE wrk_nemo, ONLY: zprn => wrk_3d_1 450 448 451 USE dynspg ! surface pressure gradient (dyn_spg routine) 449 452 USE divcur ! hor. divergence & rel. vorticity (div_cur routine) … … 453 456 INTEGER :: indic ! ??? 454 457 REAL(wp) :: zmsv, zphv, zmsu, zphu, zalfg ! temporary scalars 455 REAL(wp), DIMENSION (jpi,jpj,jpk) :: zprn ! workspace 456 !!---------------------------------------------------------------------- 458 !!---------------------------------------------------------------------- 459 460 IF(.NOT. wrk_use(3, 1))THEN 461 CALL ctl_stop('istage_uvg: requested workspace array unavailable.') 462 RETURN 463 END IF 457 464 458 465 IF(lwp) WRITE(numout,*) … … 551 558 rotb (:,:,:) = rotn (:,:,:) ! set the before to the now value 552 559 ! 560 IF(.NOT. wrk_release(3, 1))THEN 561 CALL ctl_stop('istage_uvg: failed to release workspace array.') 562 END IF 563 ! 553 564 END SUBROUTINE istate_uvg 554 565 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DTA/dtasal.F90
r2528 r2590 25 25 PRIVATE 26 26 27 PUBLIC dta_sal ! called by step.F90 and inidta.F90 28 29 LOGICAL , PUBLIC, PARAMETER :: lk_dtasal = .TRUE. !: salinity data flag 30 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: s_dta !: salinity data at given time-step 27 PUBLIC dta_sal ! called by step.F90 and inidta.F90 28 PUBLIC dta_sal_alloc ! Called by nemogcm.F90 29 30 LOGICAL , PUBLIC, PARAMETER :: lk_dtasal = .TRUE. !: salinity data flag 31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: s_dta !: salinity data at given time-step 31 32 32 33 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sal ! structure of input SST (file informations, fields read) … … 40 41 !!---------------------------------------------------------------------- 41 42 CONTAINS 43 44 FUNCTION dta_sal_alloc() 45 IMPLICIT none 46 INTEGER :: dta_sal_alloc 47 INTEGER :: ierr 48 49 ALLOCATE(s_dta(jpi,jpj,jpk), & 50 sf_sal(1), & 51 Stat=ierr) 52 IF(ierr <= 0)THEN 53 ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk) ) 54 END IF 55 56 dta_sal_alloc = ierr 57 58 END FUNCTION dta_sal_alloc 42 59 43 60 SUBROUTINE dta_sal( kt ) … … 88 105 WRITE(numout,*) '~~~~~~~ ' 89 106 ENDIF 90 ALLOCATE( sf_sal(1), STAT=ierror ) 91 IF( ierror > 0 ) THEN 92 CALL ctl_stop( 'dta_sal: unable to allocate sf_sal structure' ) ; RETURN 93 ENDIF 94 ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk) ) 107 ! ARPDBG moved first two allocate's into dta_sal_alloc() 108 !!$ ALLOCATE( sf_sal(1), STAT=ierror ) 109 !!$ IF( ierror > 0 ) THEN 110 !!$ CALL ctl_stop( 'dta_sal: unable to allocate sf_sal structure' ) ; RETURN 111 !!$ ENDIF 112 !!$ ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk) ) 95 113 IF( sn_sal%ln_tint ) ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2) ) 96 114 ! ! fill sf_sal with sn_sal and control print -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90
r2528 r2590 25 25 PRIVATE 26 26 27 PUBLIC dta_tem ! called by step.F90 and inidta.F90 27 PUBLIC dta_tem ! called by step.F90 and inidta.F90 28 PUBLIC dta_tem_alloc ! called by nemo_init in nemogcm.F90 28 29 29 30 LOGICAL , PUBLIC, PARAMETER :: lk_dtatem = .TRUE. !: temperature data flag 30 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: t_dta!: temperature data at given time-step31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_dta !: temperature data at given time-step 31 32 32 33 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tem ! structure of input SST (file informations, fields read) … … 40 41 !!---------------------------------------------------------------------- 41 42 CONTAINS 43 44 FUNCTION dta_tem_alloc() 45 IMPLICIT none 46 INTEGER :: dta_tem_alloc 47 INTEGER :: ierror 48 ALLOCATE(t_dta(jpi,jpj,jpk), & 49 sf_tem(1), & 50 STAT=ierror ) 51 IF( ierror <= 0 ) THEN 52 ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk), STAT=ierror ) 53 END IF 54 55 dta_tem_alloc = ierror 56 57 END FUNCTION dta_tem_alloc 58 42 59 43 60 SUBROUTINE dta_tem( kt ) … … 95 112 WRITE(numout,*) '~~~~~~~ ' 96 113 ENDIF 97 ALLOCATE( sf_tem(1), STAT=ierror ) 98 IF( ierror > 0 ) THEN 99 CALL ctl_stop( 'dta_tem: unable to allocate sf_tem structure' ) ; RETURN 100 ENDIF 101 ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk) ) 114 ! ARPDBG - moved into dta_tem_alloc() 115 !!$ ALLOCATE( sf_tem(1), STAT=ierror ) 116 !!$ IF( ierror > 0 ) THEN 117 !!$ CALL ctl_stop( 'dta_tem: unable to allocate sf_tem structure' ) ; RETURN 118 !!$ ENDIF 119 !!$ ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk) ) 102 120 IF( sn_tem%ln_tint ) ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) ) 103 121 ! ! fill sf_tem with sn_tem and control print -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
r2528 r2590 35 35 PRIVATE 36 36 37 PUBLIC div_cur ! routine called by step.F90 and istate.F90 37 PUBLIC div_cur ! routine called by step.F90 and istate.F90 38 PUBLIC div_cur_alloc ! routine called by nemogcm.F90 39 40 ! These workspace arrays are not replaced by wrk_nemo because they 41 ! have extents greater than (jpi,jpj) 42 REAL(wp), DIMENSION(:,:) :: zwu ! workspace 43 REAL(wp), DIMENSION(:,:) :: zwv ! workspace 38 44 39 45 !! * Substitutions … … 46 52 !!---------------------------------------------------------------------- 47 53 CONTAINS 54 55 FUNCTION div_cur_alloc() 56 !!---------------------------------------------------------------------- 57 !! *** ROUTINE div_cur_alloc *** 58 !!---------------------------------------------------------------------- 59 INTEGER :: div_cur_alloc 60 !!---------------------------------------------------------------------- 61 62 div_cur_alloc = 0 63 64 #if defined key_noslip_accurate 65 ALLOCATE(zwu( jpi, 1:jpj+2), zwv(-1:jpi+2, jpj), Stat=div_cur_alloc) 66 #endif 67 68 IF(div_cur_alloc /= 0)THEN 69 CALL ctl_warn('div_cur_alloc: failed to allocate arrays.') 70 END IF 71 72 END FUNCTION div_cur_alloc 48 73 49 74 #if defined key_noslip_accurate … … 88 113 INTEGER :: ijt, iju ! temporary integer 89 114 REAL(wp) :: zraur, zdep 90 REAL(wp), DIMENSION( jpi ,1:jpj+2) :: zwu ! workspace91 REAL(wp), DIMENSION(-1:jpi+2, jpj ) :: zwv ! workspace92 115 !!---------------------------------------------------------------------- 93 116 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
r2528 r2590 49 49 USE oce, ONLY: zfu => ta ! use ta as 3D workspace 50 50 USE oce, ONLY: zfv => sa ! use sa as 3D workspace 51 USE wrk_nemo, ONLY: zfu_t => wrk_3d_1, & ! 3D workspaces 52 zfu_f => wrk_3d_2, & 53 zfu_uw =>wrk_3d_3, & 54 zfv_t => wrk_3d_4, & 55 zfv_f => wrk_3d_5, & 56 zfv_vw =>wrk_3d_6, & 57 zfw => wrk_3d_7, & 58 wrk_use, wrk_release 59 IMPLICIT none 51 60 !! 52 61 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 54 63 INTEGER :: ji, jj, jk ! dummy loop indices 55 64 REAL(wp) :: zbu, zbv ! temporary scalars 56 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfu_t, zfu_f, zfu_uw ! 3D workspace57 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfv_t, zfv_f, zfv_vw ! - -58 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfw ! - -59 65 !!---------------------------------------------------------------------- 60 66 … … 64 70 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 65 71 ENDIF 72 73 ! Check that global workspace arrays aren't already in use 74 IF( .not. wrk_use(3, 1, 2, 3, 4, 5, 6, 7) )THEN 75 IF(lwp) WRITE(numout, *) 'dyn_adv_cen2 : run-time error - global workspace arrays already in use.' 76 CALL ctl_stop('dyn_adv_cen2 : run-time error - global workspace arrays already in use.') 77 END IF 66 78 67 79 IF( l_trddyn ) THEN ! Save ua and va trends … … 157 169 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 158 170 ! 171 ! Flag that the global workspace arrays are no longer in use 172 IF( .not. wrk_release(3, 1, 2, 3, 4, 5, 6, 7) )THEN 173 IF(lwp) WRITE(numout, *) 'dyn_adv_cen2 : run-time error - failed to release global workspace arrays.' 174 END IF 175 ! 159 176 END SUBROUTINE dyn_adv_cen2 160 177 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
r2528 r2590 70 70 USE oce, ONLY: zfu => ta ! use ta as 3D workspace 71 71 USE oce, ONLY: zfv => sa ! use sa as 3D workspace 72 USE wrk_nemo, ONLY: wrk_use, wrk_release 73 USE wrk_nemo, ONLY: zfu_t =>wrk_3d_1, & 74 zfu_f =>wrk_3d_2, & 75 zfv_t =>wrk_3d_3, & 76 zfv_f =>wrk_3d_4, & 77 zfw =>wrk_3d_5, & 78 zfu_uw =>wrk_3d_6, & 79 zfv_vw =>wrk_3d_7 80 USE wrk_nemo, ONLY: zlu_uu=>wrk_4d_1, & 81 zlu_uv=>wrk_4d_2, & 82 zlv_vv=>wrk_4d_3, & 83 zlv_vu=>wrk_4d_4 72 84 !! 73 85 INTEGER, INTENT(in) :: kt ! ocean time-step index … … 76 88 REAL(wp) :: zbu, zbv ! temporary scalars 77 89 REAL(wp) :: zui, zvj, zfuj, zfvi, zl_u, zl_v ! temporary scalars 78 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfu_t, zfu_f ! temporary workspace 79 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfv_t, zfv_f ! " " 80 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfw, zfu_uw, zfv_vw 81 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: zlu_uu, zlu_uv ! temporary workspace 82 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: zlv_vv, zlv_vu ! temporary workspace 90 ! ARPDBG - arrays below replaced with global work spaces 91 !!$ REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfu_t, zfu_f ! temporary workspace 92 !!$ REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfv_t, zfv_f ! " " 93 !!$ REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfw, zfu_uw, zfv_vw 94 !!$ REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: zlu_uu, zlu_uv ! temporary workspace 95 !!$ REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: zlv_vv, zlv_vu ! temporary workspace 83 96 !!---------------------------------------------------------------------- 84 97 … … 88 101 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 89 102 ENDIF 103 104 ! Check that required workspace arrays are not already in use 105 IF( .not. wrk_use(3, 1, 2, 3, 4, 5, 6, 7) )THEN 106 CALL ctl_stop('dyn_adv_ubs : error : required 3d workspace array is already in use') 107 END IF 108 IF(.not. wrk_use(4, 1, 2, 3, 4) )THEN 109 CALL ctl_stop('dyn_adv_ubs : error : required 4d workspace array is already in use') 110 END IF 111 90 112 zfu_t(:,:,:) = 0.e0 91 113 zfv_t(:,:,:) = 0.e0 … … 248 270 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 249 271 ! 272 ! Signal that we're done with the 3D and 4D global workspace arrays 273 IF( (.not. wrk_release(3, 1, 2, 3, 4, 5, 6, 7)) .OR. & 274 (.not. wrk_release(4, 1, 2, 3, 4)) )THEN 275 IF(lwp) WRITE(numout,*) 'dyn_adv_ubs : failed to release workspace arrays' 276 END IF 277 ! 250 278 END SUBROUTINE dyn_adv_ubs 251 279 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r2528 r2590 76 76 !! - Save the trend (l_trddyn=T) 77 77 !!---------------------------------------------------------------------- 78 USE wrk_nemo, ONLY: wrk_use, wrk_release 79 USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2 80 !! 78 81 INTEGER, INTENT(in) :: kt ! ocean time-step index 79 82 !! 80 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdu, ztrdv ! 3D temporary workspace 81 !!---------------------------------------------------------------------- 83 !!---------------------------------------------------------------------- 84 ! 85 IF(.NOT. wrk_use(3, 1,2))THEN 86 CALL ctl_stop('dyn_hpg: requested workspace arrays are unavailable.') 87 RETURN 88 END IF 82 89 ! 83 90 IF( l_trddyn ) THEN ! Temporary saving of ua and va trends (l_trddyn) … … 104 111 IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' hpg - Ua: ', mask1=umask, & 105 112 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 113 ! 114 IF(.NOT. wrk_release(3, 1,2))THEN 115 CALL ctl_stop('dyn_hpg: failed to release workspace arrays.') 116 END IF 106 117 ! 107 118 END SUBROUTINE dyn_hpg … … 594 605 USE oce, ONLY : zhpi => ta ! use ta as 3D workspace 595 606 USE oce, ONLY : zhpj => sa ! use sa as 3D workspace 607 USE wrk_nemo, ONLY: wrk_use, wrk_release 608 USE wrk_nemo, ONLY: drhox => wrk_3d_1, dzx => wrk_3d_2 609 USE wrk_nemo, ONLY: drhou => wrk_3d_3, dzu => wrk_3d_4, rho_i => wrk_3d_5 610 USE wrk_nemo, ONLY: drhoy => wrk_3d_6, dzy => wrk_3d_7 611 USE wrk_nemo, ONLY: drhov => wrk_3d_8, dzv => wrk_3d_9, rho_j => wrk_3d_10 612 USE wrk_nemo, ONLY: drhoz => wrk_3d_11, dzz => wrk_3d_12 613 USE wrk_nemo, ONLY: drhow => wrk_3d_13, dzw => wrk_3d_14 614 USE wrk_nemo, ONLY: rho_k => wrk_3d_15 596 615 !! 597 616 INTEGER, INTENT(in) :: kt ! ocean time-step index … … 601 620 REAL(wp) :: z1_10, cffu, cffx ! " " 602 621 REAL(wp) :: z1_12, cffv, cffy ! " " 603 REAL(wp), DIMENSION(jpi,jpj,jpk) :: drhox, dzx, drhou, dzu, rho_i ! 3D workspace 604 REAL(wp), DIMENSION(jpi,jpj,jpk) :: drhoy, dzy, drhov, dzv, rho_j ! " " 605 REAL(wp), DIMENSION(jpi,jpj,jpk) :: drhoz, dzz, drhow, dzw, rho_k ! " " 606 !!---------------------------------------------------------------------- 622 !!---------------------------------------------------------------------- 623 624 IF(.NOT. wrk_use(3, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15))THEN 625 CALL ctl_stop('dyn:hpg_djc : requested workspace arrays unavailable.') 626 RETURN 627 END IF 607 628 608 629 IF( kt == nit000 ) THEN … … 802 823 END DO 803 824 ! 825 IF(.NOT. wrk_release(3, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15))THEN 826 CALL ctl_stop('dyn:hpg_djc : failed to release workspace arrays.') 827 END IF 828 ! 804 829 END SUBROUTINE hpg_djc 805 830 … … 815 840 USE oce, ONLY : zhpi => ta ! use ta as 3D workspace 816 841 USE oce, ONLY : zhpj => sa ! use sa as 3D workspace 842 USE wrk_nemo, ONLY: wrk_use, wrk_release 843 USE wrk_nemo, ONLY: zdistr => wrk_2d_1, zsina => wrk_2d_2, & 844 zcosa => wrk_2d_3 845 USE wrk_nemo, ONLY: zhpiorg => wrk_3d_1, zhpirot => wrk_3d_2 846 USE wrk_nemo, ONLY: zhpitra => wrk_3d_3, zhpine => wrk_3d_4 847 USE wrk_nemo, ONLY: zhpjorg => wrk_3d_5, zhpjrot => wrk_3d_6 848 USE wrk_nemo, ONLY: zhpjtra => wrk_3d_7, zhpjne => wrk_3d_8 817 849 !! 818 850 INTEGER, INTENT(in) :: kt ! ocean time-step index … … 821 853 REAL(wp) :: zforg, zcoef0, zuap, zmskd1, zmskd1m ! temporary scalar 822 854 REAL(wp) :: zfrot , zvap, zmskd2, zmskd2m ! " " 823 REAL(wp), DIMENSION(jpi,jpj) :: zdistr, zsina, zcosa ! 2D workspace 824 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpiorg, zhpirot, zhpitra, zhpine ! 3D workspace 825 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpjorg, zhpjrot, zhpjtra, zhpjne ! " " 826 !!---------------------------------------------------------------------- 855 !!---------------------------------------------------------------------- 856 857 IF( (.NOT. wrk_use(2, 1,2,3)) .OR. & 858 (.NOT. wrk_use(3, 1,2,3,4,5,6,7,8)))THEN 859 CALL ctl_stop('dyn:hpg_rot : requested workspace arrays unavailable.') 860 RETURN 861 END IF 827 862 828 863 IF( kt == nit000 ) THEN … … 981 1016 END DO 982 1017 ! 1018 IF( (.NOT. wrk_release(2, 1,2,3)) .OR. & 1019 (.NOT. wrk_release(3, 1,2,3,4,5,6,7,8)))THEN 1020 CALL ctl_stop('dyn:hpg_rot : failed to release workspace arrays.') 1021 END IF 1022 ! 983 1023 END SUBROUTINE hpg_rot 984 1024 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
r2528 r2590 54 54 USE oce, ONLY : ztrdu => ta ! use ta as 3D workspace 55 55 USE oce, ONLY : ztrdv => sa ! use sa as 3D workspace 56 USE wrk_nemo, ONLY: wrk_use, wrk_release 57 USE wrk_nemo, ONLY: zhke => wrk_3d_1 56 58 !! 57 59 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 59 61 INTEGER :: ji, jj, jk ! dummy loop indices 60 62 REAL(wp) :: zu, zv ! temporary scalars 61 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhke ! temporary 3D workspace62 63 !!---------------------------------------------------------------------- 64 65 IF(.NOT. wrk_use(3,1))THEN 66 CALL ctl_stop('dyn_key: requested workspace array is unavailable.') 67 END IF 63 68 64 69 IF( kt == nit000 ) THEN … … 104 109 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 105 110 ! 111 IF(.NOT. wrk_release(3,1))THEN 112 CALL ctl_stop('dyn_key: failed to release workspace array.') 113 END IF 114 106 115 END SUBROUTINE dyn_keg 107 116 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
r2528 r2590 52 52 !! ** Purpose : compute the lateral ocean dynamics physics. 53 53 !!---------------------------------------------------------------------- 54 USE wrk_nemo, ONLY: wrk_use, wrk_release 55 USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2 56 !! 54 57 INTEGER, INTENT(in) :: kt ! ocean time-step index 55 !! 56 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdu, ztrdv ! 3D workspace 57 !!---------------------------------------------------------------------- 58 58 !!---------------------------------------------------------------------- 59 60 IF(.NOT. wrk_use(3, 1,2))THEN 61 CALL ctl_stop('dyn_ldf: requested workspace arrays unavailable.') 62 RETURN 63 END IF 64 ! 59 65 IF( l_trddyn ) THEN ! temporary save of ta and sa trends 60 66 ztrdu(:,:,:) = ua(:,:,:) … … 106 112 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 107 113 ! 114 IF(.NOT. wrk_release(3, 1,2))THEN 115 CALL ctl_stop('dyn_ldf: failed to release workspace arrays.') 116 END IF 117 ! 108 118 END SUBROUTINE dyn_ldf 109 119 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90
r2528 r2590 79 79 !! 9.0 ! 04-08 (C. Talandier) New trends organization 80 80 !!---------------------------------------------------------------------- 81 USE wrk_nemo, ONLY: wrk_use, wrk_release 82 USE wrk_nemo, ONLY: zcu => wrk_2d_1, zcv => wrk_2d_2 83 USE wrk_nemo, ONLY: zuf => wrk_3d_1, zut => wrk_3d_2, & 84 zlu => wrk_3d_3, zlv => wrk_3d_4 81 85 !! * Arguments 82 86 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 85 89 INTEGER :: ji, jj, jk ! dummy loop indices 86 90 REAL(wp) :: zua, zva, zbt, ze2u, ze2v ! temporary scalar 87 REAL(wp), DIMENSION(jpi,jpj) :: &88 zcu, zcv ! temporary workspace89 REAL(wp), DIMENSION(jpi,jpj,jpk) :: &90 zuf, zut, zlu, zlv ! temporary workspace91 91 !!---------------------------------------------------------------------- 92 92 !! OPA 8.5, LODYC-IPSL (2002) 93 93 !!---------------------------------------------------------------------- 94 95 IF( (.NOT. wrk_use(2, 1,2)) .OR. (.NOT. wrk_use(3, 1,2,3,4)) )THEN 96 CALL ctl_stop('dyn_ldf_bilap : requested workspace arrays unavailable.') 97 RETURN 98 END IF 94 99 95 100 IF( kt == nit000 ) THEN … … 214 219 END DO ! End of slab 215 220 ! ! =============== 216 221 IF( (.NOT. wrk_release(2, 1,2)) .OR. & 222 (.NOT. wrk_release(3, 1,2,3,4)) )THEN 223 CALL ctl_stop('dyn_ldf_bilap : failed to release workspace arrays.') 224 END IF 225 ! 217 226 END SUBROUTINE dyn_ldf_bilap 218 227 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
r2528 r2590 28 28 29 29 !! * Routine accessibility 30 PUBLIC dyn_ldf_bilapg ! called by step.F90 30 PUBLIC dyn_ldf_bilapg ! called by step.F90 31 PUBLIC dyn_ldf_bilapg_alloc ! called by nemogcm.F90 32 33 ! These are just workspace arrays but since they're (jpi,jpk) it's not 34 ! worth putting them in the wrk_nemo module. 35 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfuw, zfvw, zdiu, zdiv 36 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zdju, zdj1u, zdjv, zdj1v 31 37 32 38 !! * Substitutions … … 40 46 41 47 CONTAINS 48 49 FUNCTION dyn_ldf_bilapg_alloc() 50 !!---------------------------------------------------------------------- 51 !! *** ROUTINE dyn_ldf_bilapg_alloc *** 52 !!---------------------------------------------------------------------- 53 INTEGER :: dyn_ldf_bilapg_alloc 54 55 ALLOCATE(zfuw(jpi,jpk), zfvw(jpi,jpk), zdiu(jpi,jpk), zdiv(jpi,jpk), & 56 zdju(jpi,jpk), zdj1u(jpi,jpk), zdjv(jpi,jpk), zdj1v(jpi,jpk),& 57 Stat = dyn_ldf_bilapg_alloc) 58 59 IF(dyn_ldf_bilapg_alloc /= 0)THEN 60 CALL ctl_warn('dyn_ldf_bilapg_alloc: failed to allocate arrays') 61 END IF 62 63 END FUNCTION dyn_ldf_bilapg_alloc 64 42 65 43 66 SUBROUTINE dyn_ldf_bilapg( kt ) … … 76 99 USE oce, ONLY : zwk3 => ta, & ! use ta as 3D workspace 77 100 zwk4 => sa ! use sa as 3D workspace 78 101 USE wrk_nemo, ONLY: wrk_use, wrk_release 102 ! work array used for rotated biharmonic operator on 103 ! tracers and/or momentum 104 USE wrk_nemo, ONLY: zwk1 => wrk_3d_1, & 105 zwk2 => wrk_3d_2 79 106 !! * Arguments 80 107 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 82 109 !! * Local declarations 83 110 INTEGER :: ji, jj, jk ! dummy loop indices 84 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 85 zwk1, zwk2 ! work array used for rotated biharmonic 86 ! ! operator on tracers and/or momentum 87 !!---------------------------------------------------------------------- 111 !!---------------------------------------------------------------------- 112 113 IF(.NOT. wrk_use(3, 1,2))THEN 114 CALL ctl_stop('dyn_ldf_bilapg: requested workspace arrays unavailable.') 115 RETURN 116 END IF 88 117 89 118 IF( kt == nit000 ) THEN … … 130 159 END DO ! End of slab 131 160 ! ! =============== 132 161 IF(.NOT. wrk_release(3, 1,2))THEN 162 CALL ctl_stop('dyn_ldf_bilapg: failed to release workspace arrays.') 163 END IF 164 ! 133 165 END SUBROUTINE dyn_ldf_bilapg 134 166 … … 179 211 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 180 212 !!---------------------------------------------------------------------- 213 USE wrk_nemo, ONLY: wrk_use, wrk_release 214 USE wrk_nemo, ONLY: ziut => wrk_2d_1, zjuf => wrk_2d_2, zjvt => wrk_2d_3 215 USE wrk_nemo, ONLY: zivf => wrk_2d_4, zdku => wrk_2d_5, zdk1u => wrk_2d_6 216 USE wrk_nemo, ONLY: zdkv => wrk_2d_7, zdk1v => wrk_2d_8 217 !! 181 218 !! * Arguments 182 219 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: & … … 199 236 zbur, zbvr, zmkt, zmkf, zuav, zvav, & 200 237 zuwslpi, zuwslpj, zvwslpi, zvwslpj 201 REAL(wp), DIMENSION(jpi,jpj) :: & 202 ziut, zjuf , zjvt, zivf, & ! workspace 203 zdku, zdk1u, zdkv, zdk1v 204 REAL(wp), DIMENSION(jpi,jpk) :: & 205 zfuw, zfvw, zdiu, zdiv, & ! workspace 206 zdju, zdj1u, zdjv, zdj1v 207 !!---------------------------------------------------------------------- 208 238 !!---------------------------------------------------------------------- 239 240 IF(.NOT. wrk_use(2, 1,2,3,4,5,6,7,8))THEN 241 CALL ctl_stop('dyn:ldfguv : requested workspace arrays unavailable.') 242 RETURN 243 END IF 209 244 ! ! ********** ! ! =============== 210 245 DO jk = 1, jpkm1 ! First step ! ! Horizontal slab … … 461 496 END DO ! End of slab 462 497 ! ! =============== 498 499 IF(.NOT. wrk_release(2, 1,2,3,4,5,6,7,8))THEN 500 CALL ctl_stop('dyn:ldfguv : failed to release workspace arrays.') 501 END IF 502 ! 463 503 END SUBROUTINE ldfguv 464 504 … … 469 509 CONTAINS 470 510 SUBROUTINE dyn_ldf_bilapg( kt ) ! Dummy routine 511 INTEGER, INTENT(in) :: kt 471 512 WRITE(*,*) 'dyn_ldf_bilapg: You should not have seen this print! error?', kt 472 513 END SUBROUTINE dyn_ldf_bilapg -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
r2528 r2590 30 30 !! * Routine accessibility 31 31 PUBLIC dyn_ldf_iso ! called by step.F90 32 PUBLIC dyn_ldf_iso_alloc ! called by nemogcm.F90 33 34 ! These are just workspace arrays but because they are (jpi,jpk) in extent 35 ! we can't use the arrays in wrk_nemo for them 36 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfuw, zdiu, zdju, zdj1u 37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfvw, zdiv, zdjv, zdj1v 32 38 33 39 !! * Substitutions … … 42 48 43 49 CONTAINS 50 51 FUNCTION dyn_ldf_iso_alloc() 52 !!---------------------------------------------------------------------- 53 !! *** ROUTINE dyn_ldf_iso_alloc *** 54 !!---------------------------------------------------------------------- 55 INTEGER :: dyn_ldf_iso_alloc 56 !!---------------------------------------------------------------------- 57 58 ALLOCATE(zfuw(jpi,jpk), zdiu(jpi,jpk), zdju(jpi,jpk), zdj1u(jpi,jpk), & 59 zfvw(jpi,jpk), zdiv(jpi,jpk), zdjv(jpi,jpk), zdj1v(jpi,jpk), & 60 Stat=dyn_ldf_iso_alloc) 61 62 IF(dyn_ldf_iso_alloc /= 0)THEN 63 CALL ctl_warn('dyn_ldf_iso_alloc: array allocate failed.') 64 END IF 65 66 END FUNCTION dyn_ldf_iso_alloc 67 44 68 45 69 SUBROUTINE dyn_ldf_iso( kt ) … … 93 117 !! ! 05-11 (G. Madec) s-coordinate: horizontal diffusion 94 118 !!---------------------------------------------------------------------- 119 USE wrk_nemo, ONLY: wrk_use, wrk_release 120 USE wrk_nemo, ONLY: ziut => wrk_2d_1, zjuf => wrk_2d_2, & ! temporary workspace 121 zjvt => wrk_2d_3, zivf => wrk_2d_4, & 122 zdku => wrk_2d_5, zdk1u => wrk_2d_6, & 123 zdkv => wrk_2d_7, zdk1v => wrk_2d_8 124 !! 95 125 !! * Arguments 96 126 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 102 132 zmskt, zmskf, zbu, zbv, & 103 133 zuah, zvah 104 REAL(wp), DIMENSION(jpi,jpj) :: &105 ziut, zjuf, zjvt, zivf, & ! temporary workspace106 zdku, zdk1u, zdkv, zdk1v107 134 108 135 REAL(wp) :: & 109 136 zcoef0, zcoef3, zcoef4, zmkt, zmkf, & 110 137 zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj 111 REAL(wp), DIMENSION(jpi,jpk) :: & 112 zfuw, zdiu, zdju, zdj1u, & ! " " 113 zfvw, zdiv, zdjv, zdj1v 114 115 !!---------------------------------------------------------------------- 138 139 !!---------------------------------------------------------------------- 140 141 IF( .NOT. wrk_use(2, 1,2,3,4,5,6,7,8))THEN 142 CALL ctl_stop('dyn_ldf_iso: requested workspace arrays unavailable.') 143 RETURN 144 END IF 116 145 117 146 IF( kt == nit000 ) THEN … … 420 449 ! ! =============== 421 450 451 IF( .NOT. wrk_release(2, 1,2,3,4,5,6,7,8))THEN 452 CALL ctl_stop('dyn_ldf_iso: failed to release workspace arrays.') 453 END IF 454 422 455 END SUBROUTINE dyn_ldf_iso 423 456 … … 428 461 CONTAINS 429 462 SUBROUTINE dyn_ldf_iso( kt ) ! Empty routine 463 INTEGER, INTENT(in) :: kt 430 464 WRITE(*,*) 'dyn_ldf_iso: You should not have seen this print! error?', kt 431 465 END SUBROUTINE dyn_ldf_iso -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r2528 r2590 93 93 USE oce, ONLY : ze3u_f => ta ! use ta as 3D workspace 94 94 USE oce, ONLY : ze3v_f => sa ! use sa as 3D workspace 95 USE wrk_nemo, ONLY: wrk_use, wrk_release 96 USE wrk_nemo, ONLY: zs_t => wrk_2d_1, zs_u_1 => wrk_2d_2, & 97 zs_v_1 => wrk_2d_3 95 98 INTEGER, INTENT( in ) :: kt ! ocean time-step index 96 99 !! … … 105 108 REAL(wp) :: zv_t_ij , zv_t_ip1j ! - - 106 109 REAL(wp) :: zv_t_ijp1 ! - - 107 REAL(wp), DIMENSION(jpi,jpj) :: zs_t, zs_u_1, zs_v_1 ! temporary 2D workspace108 110 !!---------------------------------------------------------------------- 111 112 IF(.NOT. wrk_use(2, 1,2,3))THEN 113 CALL ctl_stop('dyn_nxt: requested workspace arrays unavailable.') 114 RETURN 115 END IF 109 116 110 117 IF( kt == nit000 ) THEN … … 318 325 & tab3d_2=vn, clinfo2=' Vn: ' , mask2=vmask ) 319 326 ! 327 IF(.NOT. wrk_release(2, 1,2,3))THEN 328 CALL ctl_stop('dyn_nxt: failed to release workspace arrays.') 329 END IF 330 ! 320 331 END SUBROUTINE dyn_nxt 321 332 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r2528 r2590 73 73 !! of the physical meaning of the results. 74 74 !!---------------------------------------------------------------------- 75 USE wrk_nemo, ONLY: wrk_use, wrk_release 76 USE wrk_nemo, ONLY: ztrdu => wrk_3d_4, ztrdv => wrk_3d_5 77 !! 75 78 INTEGER, INTENT(in ) :: kt ! ocean time-step index 76 79 INTEGER, INTENT( out) :: kindic ! solver flag … … 78 81 INTEGER :: ji, jj, jk ! dummy loop indices 79 82 REAL(wp) :: z2dt, zg_2 ! temporary scalar 80 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdu, ztrdv ! 3D workspace 81 !!---------------------------------------------------------------------- 82 83 !!---------------------------------------------------------------------- 84 85 IF(.NOT. wrk_use(3, 4,5))THEN 86 CALL ctl_stop('dyn_spg: requested workspace arrays unavailable.') 87 RETURN 88 END IF 83 89 84 90 !!gm NOTA BENE : the dynspg_exp and dynspg_ts should be modified so that … … 149 155 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 150 156 ! 157 IF(.NOT. wrk_release(3, 4,5))THEN 158 CALL ctl_stop('dyn_spg: failed to release workspace arrays.') 159 END IF 160 ! 151 161 END SUBROUTINE dyn_spg 152 162 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90
r2528 r2590 35 35 #if defined key_dynspg_ts || defined key_vvl || defined key_esopa 36 36 ! !!! Time splitting scheme (sub-time step variables) 37 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ua_e , va_e ! barotropic velocities (after)38 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sshn_e, ssha_e, sshn_b ! sea surface heigth (now, after, average)39 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hu_e , hv_e ! now ocean depth ( = Ho+sshn_e )40 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hur_e , hvr_e ! inverse of the now depth ( = 1/(Ho+sshn_e) )37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ua_e , va_e ! barotropic velocities (after) 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_e, ssha_e, sshn_b ! sea surface heigth (now, after, average) 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_e , hv_e ! now ocean depth ( = Ho+sshn_e ) 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur_e , hvr_e ! inverse of the now depth ( = 1/(Ho+sshn_e) ) 41 41 #endif 42 42 … … 46 46 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 47 47 !!====================================================================== 48 CONTAINS 49 50 FUNCTION dynspg_oce_alloc() 51 IMPLICIT none 52 INTEGER :: dynspg_oce_alloc 53 54 dynspg_oce_alloc = 0 55 56 #if defined key_dynspg_ts || defined key_vvl || defined key_esopa 57 ALLOCATE(ua_e(jpi,jpj), va_e(jpi,jpj) , & 58 sshn_e(jpi,jpj), ssha_e(jpi,jpj), sshn_b(jpi,jpj), & 59 hu_e(jpi,jpj), hv_e(jpi,jpj) , & 60 hur_e(jpi,jpj), hvr_e(jpi,jpj) , & 61 Stat=dynspg_oce_alloc) 62 #endif 63 64 END FUNCTION dynspg_oce_alloc 65 48 66 END MODULE dynspg_oce -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r2564 r2590 45 45 PRIVATE 46 46 47 PUBLIC dyn_spg_ts ! routine called by step.F90 48 PUBLIC ts_rst ! routine called by istate.F90 49 50 51 REAL(wp), DIMENSION(jpi,jpj) :: ftnw, ftne ! triad of coriolis parameter 52 REAL(wp), DIMENSION(jpi,jpj) :: ftsw, ftse ! (only used with een vorticity scheme) 53 54 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: un_b, vn_b ! now averaged velocity 55 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ub_b, vb_b ! before averaged velocity 47 PUBLIC dyn_spg_ts ! routine called by step.F90 48 PUBLIC ts_rst ! routine called by istate.F90 49 PUBLIC dyn_spg_ts_alloc ! routine called by nemogcm.F90 50 51 52 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftnw, ftne ! triad of coriolis parameter 53 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftsw, ftse ! (only used with een vorticity scheme) 54 55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_b, vn_b ! now averaged velocity 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub_b, vb_b ! before averaged velocity 56 57 57 58 … … 66 67 67 68 CONTAINS 69 70 FUNCTION dyn_spg_ts_alloc() 71 !!---------------------------------------------------------------------- 72 !! *** routine dyn_spg_ts_alloc *** 73 !!---------------------------------------------------------------------- 74 IMPLICIT none 75 INTEGER :: dyn_spg_ts_malloc 76 !!---------------------------------------------------------------------- 77 78 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_malloc 83 68 84 69 85 SUBROUTINE dyn_spg_ts( kt ) … … 94 110 !! References : Griffies et al., (2003): A technical guide to MOM4. NOAA/GFDL 95 111 !!--------------------------------------------------------------------- 112 USE wrk_nemo, ONLY: wrk_use, wrk_release 113 USE wrk_nemo, ONLY: zhdiv => wrk_2d_1, zsshb_e => wrk_2d_2 114 USE wrk_nemo, ONLY: zbfru => wrk_2d_3 , zbfrv => wrk_2d_4 115 USE wrk_nemo, ONLY: zsshun_e => wrk_2d_5, zsshvn_e => wrk_2d_6 116 USE wrk_nemo, ONLY: zcu => wrk_2d_7, zwx => wrk_2d_8, zua => wrk_2d_9, zun => wrk_2d_10 117 USE wrk_nemo, ONLY: zcv => wrk_2d_11, zwy => wrk_2d_12, zva => wrk_2d_13, zvn => wrk_2d_14 118 USE wrk_nemo, ONLY: zun_e => wrk_2d_15, zub_e => wrk_2d_16, zu_sum => wrk_2d_17 119 USE wrk_nemo, ONLY: zvn_e => wrk_2d_18, zvb_e => wrk_2d_19, zv_sum => wrk_2d_20 120 USE wrk_nemo, ONLY: zssh_sum => wrk_2d_21 121 !! 96 122 INTEGER, INTENT(in) :: kt ! ocean time-step index 97 123 !! … … 104 130 REAL(wp) :: zu_spg, zu_cor, zu_sld, zu_asp ! - - 105 131 REAL(wp) :: zv_spg, zv_cor, zv_sld, zv_asp ! - - 106 !!107 REAL(wp), DIMENSION(jpi,jpj) :: zhdiv, zsshb_e108 !!109 REAL(wp), DIMENSION(jpi,jpj) :: zbfru , zbfrv ! 2D workspace110 !!111 REAL(wp), DIMENSION(jpi,jpj) :: zsshun_e, zsshvn_e ! 2D workspace112 !!113 REAL(wp), DIMENSION(jpi,jpj) :: zcu, zwx, zua, zun ! 2D workspace114 REAL(wp), DIMENSION(jpi,jpj) :: zcv, zwy, zva, zvn ! - -115 REAL(wp), DIMENSION(jpi,jpj) :: zun_e, zub_e, zu_sum ! 2D workspace116 REAL(wp), DIMENSION(jpi,jpj) :: zvn_e, zvb_e, zv_sum ! - -117 REAL(wp), DIMENSION(jpi,jpj) :: zssh_sum ! - -118 132 !!---------------------------------------------------------------------- 133 134 IF(.NOT. wrk_use(2, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, & 135 11,12,13,14,15,16,17,18,19,20,21))THEN 136 CALL ctl_stop('dyn_spg_ts: requested workspace arrays unavailable.') 137 RETURN 138 END IF 119 139 120 140 IF( kt == nit000 ) THEN !* initialisation … … 550 570 ! 551 571 ! 572 IF(.NOT. wrk_release(2, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, & 573 11,12,13,14,15,16,17,18,19,20,21))THEN 574 CALL ctl_stop('dyn_spg_ts: failed to release workspace arrays.') 575 END IF 576 ! 552 577 END SUBROUTINE dyn_spg_ts 553 578 … … 641 666 CONTAINS 642 667 SUBROUTINE dyn_spg_ts( kt ) ! Empty routine 668 INTEGER, INTENT(in) :: kt 643 669 WRITE(*,*) 'dyn_spg_ts: You should not have seen this print! error?', kt 644 670 END SUBROUTINE dyn_spg_ts -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r2528 r2590 39 39 PUBLIC dyn_vor ! routine called by step.F90 40 40 PUBLIC dyn_vor_init ! routine called by opa.F90 41 PUBLIC dyn_vor_alloc ! routine called by nemogcm.F90 41 42 42 43 ! !!* Namelist namdyn_vor: vorticity term … … 50 51 INTEGER :: nrvm = 2 ! =2 relative vorticity ; =3 metric term 51 52 INTEGER :: ntot = 4 ! =4 total vorticity (relative + planetary) ; =5 coriolis + metric term 53 54 !!$#if defined key_vvl 55 !!$ REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3f 56 !!$#else 57 !!$ REAL(wp), ALLOCATABLE, DIMENSION(jpi,jpj,jpk), SAVE :: ze3f 58 !!$#endif 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ze3f 52 60 53 61 !! * Substitutions … … 61 69 62 70 CONTAINS 71 72 FUNCTION dyn_vor_alloc() 73 !!---------------------------------------------------------------------- 74 !! *** Routine dyn_vor_alloc *** 75 !!---------------------------------------------------------------------- 76 IMPLICIT none 77 INTEGER :: dyn_vor_alloc 78 !!---------------------------------------------------------------------- 79 80 ALLOCATE(ze3f(jpi,jpj,jpk), Stat=dyn_vor_alloc) 81 82 IF(dyn_vor_alloc /= 0 )THEN 83 CALL ctl_warn('dyn_vor_alloc: failed to allocate array ze3f.') 84 END IF 85 86 END FUNCTION dyn_vor_alloc 87 63 88 64 89 SUBROUTINE dyn_vor( kt ) … … 205 230 !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 206 231 !!---------------------------------------------------------------------- 232 USE wrk_nemo, ONLY: wrk_use, wrk_release 233 USE wrk_nemo, ONLY: zwx => wrk_2d_1, zwy => wrk_2d_2, zwz => wrk_2d_3 234 !! 207 235 INTEGER , INTENT(in ) :: kt ! ocean time-step index 208 236 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ; … … 214 242 REAL(wp) :: zx1, zy1, zfact2 ! temporary scalars 215 243 REAL(wp) :: zx2, zy2 ! " " 216 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zwz ! temporary 2D workspace 217 !!---------------------------------------------------------------------- 244 !!---------------------------------------------------------------------- 245 246 IF(.NOT. wrk_use(2, 1,2,3))THEN 247 CALL ctl_stop('dyn:vor_ene: requested workspace arrays unavailable.') 248 RETURN 249 END IF 218 250 219 251 IF( kt == nit000 ) THEN … … 280 312 END DO ! End of slab 281 313 ! ! =============== 314 IF(.NOT. wrk_release(2, 1,2,3))THEN 315 CALL ctl_stop('dyn:vor_ene: failed to release workspace arrays.') 316 END IF 317 ! 282 318 END SUBROUTINE vor_ene 283 319 … … 314 350 !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 315 351 !!---------------------------------------------------------------------- 352 USE wrk_nemo, ONLY: wrk_use, wrk_release 353 USE wrk_nemo, ONLY: zwx => wrk_2d_4, zwy => wrk_2d_5, & 354 zwz => wrk_2d_6, zww => wrk_2d_7 355 !! 316 356 INTEGER, INTENT(in) :: kt ! ocean timestep index 317 357 !! … … 319 359 REAL(wp) :: zfact1, zua, zcua, zx1, zy1 ! temporary scalars 320 360 REAL(wp) :: zfact2, zva, zcva, zx2, zy2 ! " " 321 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zwz, zww ! temporary 3D workspace 322 !!---------------------------------------------------------------------- 361 !!---------------------------------------------------------------------- 362 363 IF(.NOT. wrk_use(2, 4,5,6,7))THEN 364 CALL ctl_stop('dyn:vor_mix: requested workspace arrays unavailable.') 365 RETURN 366 END IF 323 367 324 368 IF( kt == nit000 ) THEN … … 392 436 END DO ! End of slab 393 437 ! ! =============== 438 IF(.NOT. wrk_release(2, 4,5,6,7))THEN 439 CALL ctl_stop('dyn:vor_mix: failed to release workspace arrays.') 440 END IF 441 ! 394 442 END SUBROUTINE vor_mix 395 443 … … 421 469 !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 422 470 !!---------------------------------------------------------------------- 471 USE wrk_nemo, ONLY: wrk_use, wrk_release 472 USE wrk_nemo, ONLY: zwx => wrk_2d_4, zwy => wrk_2d_5, zwz => wrk_2d_6 473 !! 423 474 INTEGER , INTENT(in ) :: kt ! ocean time-step index 424 475 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ; … … 429 480 INTEGER :: ji, jj, jk ! dummy loop indices 430 481 REAL(wp) :: zfact1, zuav, zvau ! temporary scalars 431 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zwz ! temporary 3D workspace432 482 !!---------------------------------------------------------------------- 433 483 484 IF(.NOT. wrk_use(2, 4,5,6))THEN 485 CALL ctl_stop('dyn:vor_ens : requested workspace arrays unavailable.') 486 RETURN 487 END IF 488 434 489 IF( kt == nit000 ) THEN 435 490 IF(lwp) WRITE(numout,*) … … 503 558 END DO ! End of slab 504 559 ! ! =============== 560 IF(.NOT. wrk_release(2, 4,5,6))THEN 561 CALL ctl_stop('dyn:vor_ens : failed to release workspace arrays.') 562 END IF 563 ! 505 564 END SUBROUTINE vor_ens 506 565 … … 525 584 !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 526 585 !!---------------------------------------------------------------------- 586 USE wrk_nemo, ONLY: wrk_use, wrk_release 587 USE wrk_nemo, ONLY: zwx => wrk_2d_1, zwy => wrk_2d_2, zwz => wrk_2d_3 588 USE wrk_nemo, ONLY: ztnw => wrk_2d_4, ztne => wrk_2d_5, & 589 ztsw => wrk_2d_6, ztse => wrk_2d_7 590 !! 527 591 INTEGER , INTENT(in ) :: kt ! ocean time-step index 528 592 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ; … … 533 597 INTEGER :: ji, jj, jk ! dummy loop indices 534 598 REAL(wp) :: zfac12, zua, zva ! temporary scalars 535 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zwz ! temporary 2D workspace 536 REAL(wp), DIMENSION(jpi,jpj) :: ztnw, ztne, ztsw, ztse ! temporary 3D workspace 537 #if defined key_vvl 538 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3f 539 #else 540 REAL(wp), DIMENSION(jpi,jpj,jpk), SAVE :: ze3f 541 #endif 542 !!---------------------------------------------------------------------- 599 !!---------------------------------------------------------------------- 600 601 IF(.NOT. wrk_use(2, 1,2,3,4,5,6,7))THEN 602 CALL ctl_stop('dyn:vor_een : requested workspace arrays unavailable.') 603 RETURN 604 END IF 543 605 544 606 IF( kt == nit000 ) THEN … … 634 696 END DO ! End of slab 635 697 ! ! =============== 698 IF(.NOT. wrk_release(2, 1,2,3,4,5,6,7))THEN 699 CALL ctl_stop('dyn:vor_een : failed to release workspace arrays.') 700 END IF 701 ! 636 702 END SUBROUTINE vor_een 637 703 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
r2528 r2590 56 56 USE oce, ONLY: zwuw => ta ! use ta as 3D workspace 57 57 USE oce, ONLY: zwvw => sa ! use sa as 3D workspace 58 USE wrk_nemo, ONLY: wrk_use, wrk_release 59 USE wrk_nemo, ONLY: zww => wrk_2d_1 60 USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2 58 61 !! 59 62 INTEGER, INTENT(in) :: kt ! ocean time-step inedx … … 61 64 INTEGER :: ji, jj, jk ! dummy loop indices 62 65 REAL(wp) :: zua, zva ! temporary scalars 63 REAL(wp), DIMENSION(jpi,jpj) :: zww ! 2D workspace64 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdu, ztrdv ! 3D workspace65 66 !!---------------------------------------------------------------------- 66 67 68 IF( (.NOT. wrk_use(2, 1)) .OR. & 69 (.NOT. wrk_use(3, 1,2)) )THEN 70 CALL ctl_stop('dyn_zad: requested workspace arrays unavailable.') 71 RETURN 72 END IF 73 67 74 IF( kt == nit000 ) THEN 68 75 IF(lwp)WRITE(numout,*) … … 119 126 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 120 127 ! 128 IF( (.NOT. wrk_release(2, 1)) .OR. & 129 (.NOT. wrk_release(3, 1,2)) )THEN 130 CALL ctl_stop('dyn_zad: failed to release workspace arrays.') 131 END IF 132 121 133 END SUBROUTINE dyn_zad 122 134 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
r2528 r2590 52 52 !! ** Purpose : compute the vertical ocean dynamics physics. 53 53 !!--------------------------------------------------------------------- 54 USE wrk_nemo, ONLY: wrk_use, wrk_release 55 USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2 56 !! 54 57 INTEGER, INTENT( in ) :: kt ! ocean time-step index 55 !!56 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdu, ztrdv ! 3D workspace57 58 !!--------------------------------------------------------------------- 58 59 60 IF(.NOT. wrk_use(3, 1,2))THEN 61 CALL ctl_stop('dyn_zdf: requested workspace arrays unavailable.') 62 RETURN 63 END IF 59 64 ! ! set time step 60 65 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra (restart with Euler time stepping) … … 89 94 IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf - Ua: ', mask1=umask, & 90 95 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 96 ! 97 IF(.NOT. wrk_release(3, 1,2))THEN 98 CALL ctl_stop('dyn_zdf: failed to release workspace arrays.') 99 END IF 91 100 ! 92 101 END SUBROUTINE dyn_zdf -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90
r2528 r2590 24 24 PRIVATE 25 25 26 PUBLIC dyn_zdf_exp ! called by step.F90 26 PUBLIC dyn_zdf_exp ! called by step.F90 27 PUBLIC dyn_zdf_exp_alloc ! called by nemogcm.F90 27 28 29 ! 2D workspaces. Not replaced with wrk_nemo arrays because these 30 ! have shape (jpi,jpk). 31 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zwx, zwy, zwz, zww 32 28 33 !! * Substitutions 29 34 # include "domzgr_substitute.h90" … … 36 41 37 42 CONTAINS 43 44 FUNCTION dyn_zdf_exp_alloc() 45 !!---------------------------------------------------------------------- 46 !! *** ROUTINE dyn_zdf_exp_alloc *** 47 !!---------------------------------------------------------------------- 48 INTEGER :: dyn_zdf_exp_alloc 49 !!---------------------------------------------------------------------- 50 51 ALLOCATE(zwx(jpi,jpk), zwy(jpi,jpk), zwz(jpi,jpk), zww(jpi,jpk), & 52 Stat=dyn_zdf_exp_alloc) 53 54 IF(dyn_zdf_exp_alloc /= 0)THEN 55 CALL ctl_warn('dyn_zdf_exp_alloc: failed to allocate arrays.') 56 END IF 57 58 END FUNCTION dyn_zdf_exp_alloc 59 38 60 39 61 SUBROUTINE dyn_zdf_exp( kt, p2dt ) … … 58 80 INTEGER :: ji, jj, jk, jl ! dummy loop indices 59 81 REAL(wp) :: zrau0r, zlavmr, zua, zva ! temporary scalars 60 REAL(wp), DIMENSION(jpi,jpk) :: zwx, zwy, zwz, zww ! 2D workspace61 82 !!---------------------------------------------------------------------- 62 83 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r2528 r2590 56 56 USE oce, ONLY : zwd => ta ! use ta as workspace 57 57 USE oce, ONLY : zws => sa ! use sa as workspace 58 USE wrk_nemo, ONLY: wrk_use, wrk_release 59 USE wrk_nemo, ONLY: zwi => wrk_3d_3 ! workspace 58 60 !! 59 61 INTEGER , INTENT( in ) :: kt ! ocean time-step index … … 63 65 REAL(wp) :: z1_p2dt, zcoef ! temporary scalars 64 66 REAL(wp) :: zzwi, zzws, zrhs ! temporary scalars 65 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi ! 3D workspace66 67 !!---------------------------------------------------------------------- 68 69 IF(.NOT. wrk_use(3, 3))THEN 70 CALL ctl_stop('dyn_zdf_imp : requested workspace array unavailable.') 71 RETURN 72 END IF 67 73 68 74 IF( kt == nit000 ) THEN … … 253 259 END DO 254 260 ! 261 IF(.NOT. wrk_release(3, 3))THEN 262 CALL ctl_stop('dyn_zdf_imp : failed to release workspace array.') 263 END IF 264 ! 255 265 END SUBROUTINE dyn_zdf_imp 256 266 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r2528 r2590 76 76 !!---------------------------------------------------------------------- 77 77 USE oce, ONLY : z3d => ta ! use ta as 3D workspace 78 USE wrk_nemo, ONLY: wrk_use, wrk_release 79 USE wrk_nemo, ONLY: zhdiv => wrk_2d_1, z2d => wrk_2d_2 78 80 !! 79 81 INTEGER, INTENT(in) :: kt ! time step … … 82 84 REAL(wp) :: zcoefu, zcoefv, zcoeff ! temporary scalars 83 85 REAL(wp) :: z2dt, z1_2dt, z1_rau0 ! temporary scalars 84 REAL(wp), DIMENSION(jpi,jpj) :: zhdiv ! 2D workspace 85 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 86 !!---------------------------------------------------------------------- 86 !!---------------------------------------------------------------------- 87 88 IF(.NOT. wrk_use(2, 1,2))THEN 89 CALL ctl_stop('ssh_wzv: requested workspace arrays unavailable.') 90 RETURN 91 END IF 87 92 88 93 IF( kt == nit000 ) THEN … … 239 244 IF(ln_ctl) CALL prt_ctl( tab2d_1=ssha, clinfo1=' ssha - : ', mask1=tmask, ovlap=1 ) 240 245 ! 246 IF(.NOT. wrk_release(2, 1,2))THEN 247