Changeset 2715 for trunk/NEMOGCM/NEMO/LIM_SRC_2
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- Location:
- trunk/NEMOGCM/NEMO/LIM_SRC_2
- Files:
-
- 19 edited
-
dom_ice_2.F90 (modified) (2 diffs)
-
ice_2.F90 (modified) (6 diffs)
-
iceini_2.F90 (modified) (5 diffs)
-
limadv_2.F90 (modified) (7 diffs)
-
limdia_2.F90 (modified) (7 diffs)
-
limdmp_2.F90 (modified) (1 diff)
-
limdyn_2.F90 (modified) (4 diffs)
-
limhdf_2.F90 (modified) (6 diffs)
-
limmsh_2.F90 (modified) (4 diffs)
-
limrhg_2.F90 (modified) (4 diffs)
-
limsbc_2.F90 (modified) (14 diffs)
-
limtab_2.F90 (modified) (2 diffs)
-
limthd_2.F90 (modified) (4 diffs)
-
limthd_lac_2.F90 (modified) (7 diffs)
-
limthd_zdf_2.F90 (modified) (10 diffs)
-
limtrp_2.F90 (modified) (3 diffs)
-
limwri_2.F90 (modified) (8 diffs)
-
limwri_dimg_2.h90 (modified) (3 diffs)
-
thd_ice_2.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90
r2528 r2715 15 15 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 16 16 !!---------------------------------------------------------------------- 17 USE par_ice_2 17 USE par_ice_2 ! LIM parameters 18 18 19 19 IMPLICIT NONE 20 20 PRIVATE 21 22 PUBLIC dom_ice_alloc_2 ! Called from nemogcm.F90 21 23 22 24 LOGICAL, PUBLIC :: l_jeq = .TRUE. !: Equator inside the domain flag … … 25 27 ! ! (otherwise = jpj+10 (SH) or -10 (SH) ) 26 28 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 averages29 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fs2cor , fcor !: coriolis factor and coeficient 30 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: covrai !: sine of geographic latitude 31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: area !: surface of grid cell 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tms , tmu !: temperature and velocity points masks 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wght !: weight of the 4 neighbours to compute averages 32 34 33 35 34 36 # 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 coefficients37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: akappa , bkappa !: first and third group of metric coefficients 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:,:) :: alambd !: second group of metric coefficients 37 39 # 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 > 040 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmv , tmf !: y-velocity and F-points masks 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmi !: ice mask: =1 if ice thick > 0 40 42 # endif 43 !!---------------------------------------------------------------------- 44 CONTAINS 45 46 INTEGER FUNCTION dom_ice_alloc_2() 47 !!---------------------------------------------------------------------- 48 USE lib_mpp, ONLY: ctl_warn ! MPP library 49 INTEGER :: ierr(2) 50 !!---------------------------------------------------------------------- 51 ierr(:) = 0 52 ! 53 ALLOCATE( fs2cor(jpi,jpj) , fcor(jpi,jpj) , & 54 & covrai(jpi,jpj) , area(jpi,jpj) , tms(jpi,jpj) , tmu(jpi,jpj) , & 55 & wght (jpi,jpj,2,2) , STAT=ierr(1) ) 56 ! 57 ALLOCATE( & 58 #if defined key_lim2_vp 59 & akappa(jpi,jpj,2,2) , bkappa(jpi,jpj,2,2), & 60 & alambd(jpi,jpj,2,2,2,2) , & 61 #else 62 & tmv(jpi,jpj) , tmf(jpi,jpj) , tmi(jpi,jpj) , & 63 #endif 64 & STAT=ierr(2) ) 65 ! 66 dom_ice_alloc_2 = MAXVAL(ierr) 67 IF( dom_ice_alloc_2 /= 0 ) CALL ctl_warn('dom_ice_alloc_2: failed to allocate arrays') 68 ! 69 END FUNCTION dom_ice_alloc_2 41 70 42 71 #else -
trunk/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90
r2528 r2715 4 4 !! Sea Ice physics: diagnostics variables of ice defined in memory 5 5 !!===================================================================== 6 !! History : 2.0 ! 2003-08 (C. Ethe) F90: Free form and module 7 !! 3.3 ! 2009-05 (G.Garric) addition of the lim2_evp cas 6 !! History : 2.0 ! 2003-08 (C. Ethe) F90: Free form and module 7 !! 3.3 ! 2009-05 (G.Garric) addition of the lim2_evp cas 8 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_lim2 … … 11 12 !! 'key_lim2' : LIM 2.0 sea-ice model 12 13 !!---------------------------------------------------------------------- 13 USE par_ice_2 14 USE par_ice_2 ! LIM sea-ice parameters 14 15 15 16 IMPLICIT NONE 16 17 PRIVATE 17 18 19 PUBLIC ice_alloc_2 ! Called in iceini_2.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 pointers83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: hsnm , hicm !: target vt_s,vt_i pointers 81 84 #endif 82 85 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)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) 112 115 113 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jplayersp1) :: tbif !: Temperature inside the ice/snow layer116 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 volume 117 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sxsn, sysn, sxxsn, syysn, sxysn !: for snow volume 118 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sxa, sya, sxxa, syya, sxya !: for ice cover area 119 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sxc0, syc0, sxxc0, syyc0, sxyc0 !: for heat content of snow 120 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sxc1, syc1, sxxc1, syyc1, sxyc1 !: for heat content of 1st ice layer 121 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sxc2, syc2, sxxc2, syyc2, sxyc2 !: for heat content of 2nd ice layer 122 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sxst, syst, sxxst, syyst, sxyst !: for heat content of brine pockets 119 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 126 !!---------------------------------------------------------------------- 127 CONTAINS 128 129 INTEGER FUNCTION ice_alloc_2() 130 !!----------------------------------------------------------------- 131 !! *** FUNCTION ice_alloc_2 *** 132 !!----------------------------------------------------------------- 133 USE lib_mpp, ONLY: ctl_warn ! MPP library 134 INTEGER :: ierr(9) ! Local variables 135 !!----------------------------------------------------------------- 136 ierr(:) = 0 137 ! 138 ALLOCATE( ahiu(jpi,jpj) , pahu(jpi,jpj) , & 139 & ahiv(jpi,jpj) , pahv(jpi,jpj) , ust2s(jpi,jpj) , STAT=ierr(1) ) 140 ! 141 !* Ice Rheology 142 #if defined key_lim2_vp 143 ALLOCATE( hsnm(jpi,jpj) , hicm(jpi,jpj) , STAT=ierr(2) ) 144 #else 145 ALLOCATE( stress1_i (jpi,jpj) , delta_i(jpi,jpj) , at_i(jpi,jpj) , & 146 stress2_i (jpi,jpj) , divu_i (jpi,jpj) , hsnm(jpi,jpj) , & 147 stress12_i(jpi,jpj) , shear_i(jpi,jpj) , hicm(jpi,jpj) , STAT=ierr(2) ) 148 #endif 149 ALLOCATE( rdvosif(jpi,jpj) , rdvobif(jpi,jpj) , & 150 & fdvolif(jpi,jpj) , rdvonif(jpi,jpj) , & 151 & sist (jpi,jpj) , tfu (jpi,jpj) , hicif(jpi,jpj) , & 152 & hsnif (jpi,jpj) , hicifp (jpi,jpj) , frld (jpi,jpj) , STAT=ierr(3) ) 153 154 ALLOCATE(phicif(jpi,jpj) , pfrld (jpi,jpj) , qstoif (jpi,jpj) , & 155 & fbif (jpi,jpj) , rdmsnif(jpi,jpj) , rdmicif(jpi,jpj) , & 156 & qldif (jpi,jpj) , qcmif (jpi,jpj) , fdtcn (jpi,jpj) , & 157 & qdtcn (jpi,jpj) , thcm (jpi,jpj) , STAT=ierr(4) ) 158 159 ALLOCATE(fstric(jpi,jpj) , ffltbif(jpi,jpj) , fscmbq(jpi,jpj) , & 160 & fsbbq (jpi,jpj) , qfvbq (jpi,jpj) , dmgwi (jpi,jpj) , & 161 & u_ice (jpi,jpj) , v_ice (jpi,jpj) , & 162 & u_oce (jpi,jpj) , v_oce (jpi,jpj) , & 163 & tbif (jpi,jpj,jplayersp1) , STAT=ierr(5)) 164 165 !* moment used in the advection scheme 166 ALLOCATE(sxice (jpi,jpj) , syice (jpi,jpj) , sxxice(jpi,jpj) , & 167 & syyice(jpi,jpj) , sxyice(jpi,jpj) , & 168 & sxsn (jpi,jpj) , sysn (jpi,jpj) , sxxsn (jpi,jpj) , & 169 & syysn (jpi,jpj) , sxysn (jpi,jpj) , STAT=ierr(6) ) 170 ALLOCATE(sxa (jpi,jpj) , sya (jpi,jpj) , sxxa (jpi,jpj) , & 171 & syya (jpi,jpj) , sxya (jpi,jpj) , & 172 & sxc0 (jpi,jpj) , syc0 (jpi,jpj) , sxxc0 (jpi,jpj) , & 173 & syyc0 (jpi,jpj) , sxyc0 (jpi,jpj) , STAT=ierr(7)) 174 ALLOCATE(sxc1 (jpi,jpj) , syc1 (jpi,jpj) , sxxc1 (jpi,jpj) , & 175 & syyc1 (jpi,jpj) , sxyc1 (jpi,jpj) , & 176 & sxc2 (jpi,jpj) , syc2 (jpi,jpj) , sxxc2 (jpi,jpj) , & 177 & syyc2 (jpi,jpj) , sxyc2 (jpi,jpj) , STAT=ierr(8)) 178 ALLOCATE(sxst (jpi,jpj) , syst (jpi,jpj) , sxxst (jpi,jpj) , & 179 & syyst (jpi,jpj) , sxyst (jpi,jpj) , STAT=ierr(9)) 180 ! 181 ice_alloc_2 = MAXVAL( ierr ) 182 ! 183 IF( ice_alloc_2 /= 0 ) CALL ctl_warn('ice_alloc_2: failed to allocate arrays') 184 ! 185 END FUNCTION ice_alloc_2 123 186 124 187 #else … … 127 190 !!---------------------------------------------------------------------- 128 191 #endif 129 130 !!---------------------------------------------------------------------- 192 !!----------------------------------------------------------------- 131 193 !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 132 194 !! $Id$ -
trunk/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90
r2528 r2715 4 4 !! Sea-ice model : LIM 2.0 Sea ice model Initialization 5 5 !!====================================================================== 6 !! History : 1.0 ! 02-08 (G. Madec) F90: Free form and modules 7 !! 2.0 ! 03-08 (C. Ethe) add ice_run 8 !! 3.3 ! 09-05 (G.Garric, C. Bricaud) addition of the lim2_evp case 6 !! History : 1.0 ! 2002-08 (G. Madec) F90: Free form and modules 7 !! 2.0 ! 2003-08 (C. Ethe) add ice_run 8 !! 3.3 ! 2009-05 (G. Garric, C. Bricaud) addition of the lim2_evp case 9 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_lim2 … … 12 13 !! 'key_lim2' : LIM 2.0 sea-ice model 13 14 !!---------------------------------------------------------------------- 14 !!----------------------------------------------------------------------15 15 !! ice_init_2 : sea-ice model initialization 16 16 !! ice_run_2 : Definition some run parameter for ice model 17 17 !!---------------------------------------------------------------------- 18 USE phycst ! physical constants 18 19 USE dom_oce ! ocean domain 19 USE dom_ice_2 ! LIM2: ice domain20 20 USE sbc_oce ! surface boundary condition: ocean 21 USE sbc_ice ! surface boundary condition: ice 22 USE phycst ! Define parameters for the routines 23 USE ice_2 ! LIM2: ice variable 24 USE limmsh_2 ! LIM2: mesh 25 USE limistate_2 ! LIM2: initial state 26 USE limrst_2 ! LIM2: restart 21 USE sbc_ice ! LIM2 surface boundary condition 22 USE dom_ice_2 ! LIM2 ice domain 23 USE par_ice_2 ! LIM2 parameters 24 USE thd_ice_2 ! LIM2 thermodynamical variables 25 USE limrhg ! LIM2 rheology 26 USE ice_2 ! LIM2 ice variable 27 USE limmsh_2 ! LIM2 mesh 28 USE limistate_2 ! LIM2 initial state 29 USE limrst_2 ! LIM2 restart 30 USE limsbc_2 ! LIM2 surface boundary condition 27 31 USE in_out_manager ! I/O manager 28 32 USE lib_mpp ! MPP library 33 29 34 IMPLICIT NONE 30 35 PRIVATE … … 33 38 34 39 !!---------------------------------------------------------------------- 35 !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)40 !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011) 36 41 !! $Id$ 37 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 45 50 !! ** purpose : initialisation of LIM-2 domain and variables 46 51 !!---------------------------------------------------------------------- 52 INTEGER :: ierr 53 !!---------------------------------------------------------------------- 47 54 ! 55 IF(lwp) THEN 56 WRITE(numout,*) 57 WRITE(numout,*) 'ice_init_2 : LIM-2 sea-ice - initialization' 58 WRITE(numout,*) '~~~~~~~~~~~ ' 59 ENDIF 60 ! ! Allocate the ice arrays 61 ierr = ice_alloc_2 () ! ice variables 62 ierr = ierr + dom_ice_alloc_2() ! domain 63 ierr = ierr + sbc_ice_alloc () ! surface forcing 64 ierr = ierr + thd_ice_alloc_2() ! thermodynamics 65 #if ! defined key_lim2_vp 66 ierr = ierr + lim_rhg_alloc () 67 #endif 68 IF( lk_mpp ) CALL mpp_sum( ierr ) 69 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'ice_init_2 : unable to allocate ice arrays' ) 70 71 ! ! adequation jpk versus ice/snow layers 72 IF( jpl > jpk .OR. jplayersp1 > jpk ) CALL ctl_stop( 'STOP', & 73 & 'ice_init: the 3rd dimension of workspace arrays is too small.', & 74 & 'use more ocean levels or less ice layers/categories.' ) 75 48 76 ! ! Open the namelist file 49 77 CALL ctl_opn( numnam_ice, 'namelist_ice', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) … … 61 89 ENDIF 62 90 ! 63 tn_ice(:,:,1) = sist(:,:) ! initialisation of ice temperature 64 fr_i (:,:) = 1.0 - frld(:,:) ! initialisation of sea-ice fraction 91 tn_ice(:,:,1) = sist(:,:) ! ice temperature known by the ocean 92 fr_i (:,:) = 1.0 - frld(:,:) ! sea-ice fraction known by the ocean 93 ! 94 CALL lim_sbc_init_2 ! ice surface boundary condition 95 ! 96 IF( lk_lim2_vp ) THEN ; WRITE(numout,*) ' VP rheology - B-grid case' 97 ELSE ; WRITE(numout,*) ' EVP rheology - C-grid case' 98 ENDIF 65 99 ! 66 100 END SUBROUTINE ice_init_2 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90
r2528 r2715 22 22 USE lbclnk 23 23 USE in_out_manager ! I/O manager 24 USE lib_mpp ! MPP library 24 25 USE prtctl ! Print control 25 26 … … 58 59 !! Reference: Prather, 1986, JGR, 91, D6. 6671-6681. 59 60 !!-------------------------------------------------------------------- 61 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 62 USE wrk_nemo, ONLY: zf0 => wrk_2d_11 , zfx => wrk_2d_12 , zfy => wrk_2d_13 , zbet => wrk_2d_14 ! 2D workspace 63 USE wrk_nemo, ONLY: zfm => wrk_2d_15 , zfxx => wrk_2d_16 , zfyy => wrk_2d_17 , zfxy => wrk_2d_18 ! - - 64 USE wrk_nemo, ONLY: zalg => wrk_2d_19 , 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) … … 65 71 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: psx , psy ! 1st moments 66 72 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: psxx, psyy, psxy ! 2nd moments 67 ! !73 ! 68 74 INTEGER :: ji, jj ! dummy loop indices 69 75 REAL(wp) :: zs1max, zrdt, zslpmax, ztemp, zin0 ! temporary scalars 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( wrk_in_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.' ) ; RETURN 82 ENDIF 76 83 77 84 ! Limitation of moments. … … 218 225 ENDIF 219 226 ! 227 IF( wrk_not_released(2, 11,12,13,14,15,16,17,18,19,20,21) ) & 228 CALL ctl_stop( 'lim_adv_x_2 : failed to release workspace arrays.' ) 229 ! 220 230 END SUBROUTINE lim_adv_x_2 221 231 … … 235 245 !! Reference: Prather, 1986, JGR, 91, D6. 6671-6681. 236 246 !!--------------------------------------------------------------------- 247 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 248 USE wrk_nemo, ONLY: zf0 => wrk_2d_11 , zfx => wrk_2d_12 , zfy => wrk_2d_13 , zbet => wrk_2d_14 ! 2D workspace 249 USE wrk_nemo, ONLY: zfm => wrk_2d_15 , zfxx => wrk_2d_16 , zfyy => wrk_2d_17 , zfxy => wrk_2d_18 ! - - 250 USE wrk_nemo, ONLY: zalg => wrk_2d_19 , zalg1 => wrk_2d_20 , zalg1q => wrk_2d_21 ! - - 251 !! 237 252 REAL(wp) , INTENT(in ) :: pdf ! reduction factor for the time step 238 253 REAL(wp) , INTENT(in ) :: pcrh ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0) … … 247 262 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 248 263 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 264 !--------------------------------------------------------------------- 265 266 IF(wrk_in_use(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 267 CALL ctl_stop( 'lim_adv_y_2 : requested workspace arrays unavailable.' ) ; RETURN 268 END IF 253 269 254 270 ! Limitation of moments. … … 398 414 ENDIF 399 415 ! 416 IF( wrk_not_released(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 417 CALL ctl_stop( 'lim_adv_y_2 : failed to release workspace arrays.' ) 418 END IF 419 ! 400 420 END SUBROUTINE lim_adv_y_2 401 421 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90
r2528 r2715 12 12 !! 'key_lim2' : LIM 2.0 sea-ice model 13 13 !!---------------------------------------------------------------------- 14 !!----------------------------------------------------------------------15 14 !! lim_dia_2 : computation of the time evolution of keys var. 16 15 !! lim_dia_init_2 : initialization and namelist read … … 24 23 USE limistate_2 ! 25 24 USE in_out_manager ! I/O manager 25 USE lib_mpp ! MPP library 26 26 27 27 IMPLICIT NONE … … 29 29 30 30 PUBLIC lim_dia_2 ! called by sbc_ice_lim_2 31 31 32 INTEGER, PUBLIC :: ntmoy = 1 , & !: instantaneous values of ice evolution or averaging ntmoy 32 33 & ninfo = 1 !: frequency of ouputs on file ice_evolu in case of averaging … … 52 53 REAL(wp) :: epsi06 = 1.e-06 ! ??? 53 54 REAL(wp), DIMENSION(jpinfmx) :: vinfom ! temporary working space 54 REAL(wp), DIMENSION(jpi,jpj) :: aire ! masked grid cell area55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: aire ! masked grid cell area 55 56 56 57 !! * Substitutions … … 61 62 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 62 63 !!---------------------------------------------------------------------- 63 64 64 CONTAINS 65 65 … … 173 173 !!------------------------------------------------------------------- 174 174 CHARACTER(len=jpchinf) :: titinf 175 INTEGER :: jv ! dummy loop indice 176 INTEGER :: ntot , ndeb 177 INTEGER :: nv ! indice of variable 178 REAL(wp) :: zxx0, zxx1 ! temporary scalars 175 INTEGER :: jv ! dummy loop indice 176 INTEGER :: ntot , ndeb, nv, ierr ! local integer 177 REAL(wp) :: zxx0, zxx1 ! local scalars 179 178 180 179 NAMELIST/namicedia/fmtinf, nfrinf, ninfo, ntmoy 181 180 !!------------------------------------------------------------------- 182 181 183 ! Read Namelist namicedia 184 REWIND ( numnam_ice ) 185 READ ( numnam_ice , namicedia ) 182 REWIND( numnam_ice ) ! Read Namelist namicedia 183 READ ( numnam_ice , namicedia ) 186 184 187 IF(lwp) THEN 185 IF(lwp) THEN ! control print 188 186 WRITE(numout,*) 189 187 WRITE(numout,*) 'lim_dia_init_2 : ice parameters for ice diagnostics ' … … 195 193 ENDIF 196 194 197 ! masked grid cell area 195 ALLOCATE( aire(jpi,jpj) , STAT=ierr ) ! masked grid cell area 196 IF( lk_mpp ) CALL mpp_sum( ierr ) 197 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'lim_dia_init_2 : unable to allocate standard arrays' ) 198 198 aire(:,:) = area(:,:) * tms(:,:) 199 199 200 ! Titles of ice key variables : 201 nv = 1 200 nv = 1 ! Titles of ice key variables 202 201 titvar(nv) = 'NoIt' ! iteration number 203 202 nv = nv + 1 204 203 titvar(nv) = 'T yr' ! time step in years 205 206 204 nbvt = nv - 1 207 208 205 nv = nv + 1 ; titvar(nv) = 'AEFN' ! sea ice area in the northern Hemisp.(10^12 km2) 209 206 nv = nv + 1 ; titvar(nv) = 'AEFS' ! sea ice area in the southern Hemisp.(10^12 km2) -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90
r2528 r2715 13 13 !! lim_dmp_2 : ice model damping 14 14 !!---------------------------------------------------------------------- 15 USE in_out_manager ! I/O manager16 15 USE ice_2 ! ice variables 17 16 USE sbc_oce, ONLY : nn_fsbc ! for fldread 18 17 USE dom_oce ! for mi0; mi1 etc ... 19 18 USE fldread ! read input fields 20 19 USE in_out_manager ! I/O manager 20 USE lib_mpp ! MPP library 21 21 22 IMPLICIT NONE 22 23 PRIVATE -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90
r2528 r2715 58 58 !! - treatment of the case if no ice dynamic 59 59 !!--------------------------------------------------------------------- 60 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 61 USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_2 62 USE wrk_nemo, ONLY: zu_io => wrk_2d_1, zv_io => wrk_2d_2 ! ice-ocean velocity 63 ! 60 64 INTEGER, INTENT(in) :: kt ! number of iteration 61 65 !! … … 63 67 INTEGER :: i_j1, i_jpj ! Starting/ending j-indices for rheology 64 68 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 69 REAL(wp), POINTER, DIMENSION(:) :: zind ! i-averaged indicator of sea-ice 70 REAL(wp), POINTER, DIMENSION(:) :: zmsk ! i-averaged of tmask 68 71 !!--------------------------------------------------------------------- 72 73 IF( wrk_in_use(1, 1,2) .OR. wrk_in_use(2, 1,2) ) THEN 74 CALL ctl_stop( 'lim_dyn_2 : requested workspace arrays unavailable' ) ; RETURN 75 ENDIF 76 zind => wrk_1d_1(1:jpj) ! Set-up pointers to sub-arrays of workspaces 77 zmsk => wrk_1d_2(1:jpj) 69 78 70 79 IF( kt == nit000 ) CALL lim_dyn_init_2 ! Initialization (first time-step only) … … 93 102 ! 94 103 DO jj = 1, jpj 95 zind(jj) = SUM( frld (:,jj ) ) ! = FLOAT(jpj) if ocean everywhere on a j-line96 zmsk(jj) = SUM( tmask(:,jj,1) ) ! = 0 104 zind(jj) = SUM( frld (:,jj ) ) ! = REAL(jpj) if ocean everywhere on a j-line 105 zmsk(jj) = SUM( tmask(:,jj,1) ) ! = 0 if land everywhere on a j-line 97 106 END DO 98 107 ! … … 200 209 ! 201 210 IF(ln_ctl) CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn : ust2s :') 211 ! 212 IF( wrk_not_released(1, 1,2) .OR. & 213 wrk_not_released(2, 1,2) ) CALL ctl_stop('lim_dyn_2 : failed to release workspace arrays') 202 214 ! 203 215 END SUBROUTINE lim_dyn_2 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90
r2528 r2715 4 4 !! LIM 2.0 ice model : horizontal diffusion of sea-ice quantities 5 5 !!====================================================================== 6 !! History : LIM ! 2000-01 (LIM) Original code 7 !! - ! 2001-05 (G. Madec, R. Hordoir) opa norm 8 !! 1.0 ! 2002-08 (C. Ethe) F90, free form 9 !!---------------------------------------------------------------------- 6 10 #if defined key_lim2 7 11 !!---------------------------------------------------------------------- … … 10 14 !! lim_hdf_2 : diffusion trend on sea-ice variable 11 15 !!---------------------------------------------------------------------- 12 !! * Modules used 13 USE dom_oce 14 USE in_out_manager 15 USE ice_2 16 USE lbclnk 17 USE lib_mpp 18 USE prtctl ! Print control 16 USE dom_oce ! ocean domain 17 USE ice_2 ! LIM-2: ice variables 18 USE lbclnk ! lateral boundary condition - MPP exchanges 19 USE lib_mpp ! MPP library 20 USE prtctl ! Print control 21 USE in_out_manager ! I/O manager 19 22 20 23 IMPLICIT NONE 21 24 PRIVATE 22 25 23 !! * Routine accessibility 24 PUBLIC lim_hdf_2 ! called by lim_tra_2 26 PUBLIC lim_hdf_2 ! called by limtrp_2.F90 25 27 26 !! * Module variables27 LOGICAL :: linit = .TRUE. ! ???28 REAL(wp) :: epsi04 = 1e-04 ! constant29 REAL(wp), DIMENSION(jpi,jpj) :: zfact ! ???28 LOGICAL :: linit = .TRUE. ! ! initialization flag (set to flase after the 1st call) 29 REAL(wp) :: epsi04 = 1e-04 ! constant 30 31 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: efact ! metric coefficient 30 32 31 33 !! * Substitution 32 34 # include "vectopt_loop_substitute.h90" 33 35 !!---------------------------------------------------------------------- 34 !! NEMO/LIM2 3.3, UCL - NEMO Consortium (2010)36 !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2010) 35 37 !! $Id$ 36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)38 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 37 39 !!---------------------------------------------------------------------- 38 39 40 CONTAINS 40 41 … … 43 44 !! *** ROUTINE lim_hdf_2 *** 44 45 !! 45 !! ** purpose : Compute and add the diffusive trend on sea-ice 46 !! variables 46 !! ** purpose : Compute and add the diffusive trend on sea-ice variables 47 47 !! 48 48 !! ** method : Second order diffusive operator evaluated using a 49 !! Cranck-Nicholson time Scheme.49 !! Cranck-Nicholson time Scheme. 50 50 !! 51 51 !! ** Action : update ptab with the diffusive contribution 52 !!53 !! History :54 !! ! 00-01 (LIM) Original code55 !! ! 01-05 (G. Madec, R. Hordoir) opa norm56 !! ! 02-08 (C. Ethe) F90, free form57 52 !!------------------------------------------------------------------- 58 ! * Arguments 59 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: & 60 ptab ! Field on which the diffusion is applied 61 REAL(wp), DIMENSION(jpi,jpj) :: & 62 ptab0 ! ??? 63 64 ! * Local variables 65 INTEGER :: ji, jj ! dummy loop indices 66 INTEGER :: & 67 its, iter ! temporary integers 53 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 54 USE wrk_nemo, ONLY: zflu => wrk_2d_11, zdiv => wrk_2d_13, zrlx => wrk_2d_15 55 USE wrk_nemo, ONLY: zflv => wrk_2d_12, zdiv0 => wrk_2d_14, ztab0 => wrk_2d_16 56 ! 57 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: ptab ! Field on which the diffusion is applied 58 ! 59 INTEGER :: ji, jj ! dummy loop indices 60 INTEGER :: its, iter, ierr ! local integers 61 REAL(wp) :: zalfa, zrlxint, zconv, zeps ! local scalars 68 62 CHARACTER (len=55) :: charout 69 REAL(wp) :: &70 zalfa, zrlxint, zconv, zeps ! temporary scalars71 REAL(wp), DIMENSION(jpi,jpj) :: &72 zrlx, zflu, zflv, & ! temporary workspaces73 zdiv0, zdiv ! " "74 63 !!------------------------------------------------------------------- 75 64 76 ! Initialisation 77 ! --------------- 78 ! Time integration parameters 79 zalfa = 0.5 ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit 80 its = 100 ! Maximum number of iteration 81 zeps = 2. * epsi04 65 IF( wrk_in_use(2, 11,12,13,14,15,16) ) THEN 66 CALL ctl_stop( 'lim_hdf_2 : requested workspace arrays unavailable.' ) ; RETURN 67 END IF 82 68 83 ! Arrays initialization 84 ptab0 (:, : ) = ptab(:,:) 85 !bug zflu (:,jpj) = 0.e0 86 !bug zflv (:,jpj) = 0.e0 87 zdiv0(:, 1 ) = 0.e0 88 zdiv0(:,jpj) = 0.e0 89 IF( .NOT.lk_vopt_loop ) THEN 90 zflu (jpi,:) = 0.e0 91 zflv (jpi,:) = 0.e0 92 zdiv0(1, :) = 0.e0 93 zdiv0(jpi,:) = 0.e0 94 ENDIF 95 96 ! Metric coefficient (compute at the first call and saved in 97 IF( linit ) THEN 69 ! !== Initialisation ==! 70 ! 71 IF( linit ) THEN ! Metric coefficient (compute at the first call and saved in efact) 72 ALLOCATE( efact(jpi,jpj) , STAT=ierr ) 73 IF( lk_mpp ) CALL mpp_sum( ierr ) 74 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'lim_hdf_2 : unable to allocate standard arrays' ) 98 75 DO jj = 2, jpjm1 99 76 DO ji = fs_2 , fs_jpim1 ! vector opt. 100 zfact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj ) + e1v(ji,jj) + e1v(ji,jj-1) ) & 101 & / ( e1t(ji,jj) * e2t(ji,jj) ) 77 efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) / ( e1t(ji,jj) * e2t(ji,jj) ) 102 78 END DO 103 79 END DO 104 80 linit = .FALSE. 105 81 ENDIF 82 ! 83 ! ! Time integration parameters 84 zalfa = 0.5_wp ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit 85 its = 100 ! Maximum number of iteration 86 zeps = 2._wp * epsi04 87 ! 88 ztab0(:, : ) = ptab(:,:) ! Arrays initialization 89 zdiv0(:, 1 ) = 0._wp 90 zdiv0(:,jpj) = 0._wp 91 IF( .NOT.lk_vopt_loop ) THEN 92 zflu (jpi,:) = 0._wp 93 zflv (jpi,:) = 0._wp 94 zdiv0(1, :) = 0._wp 95 zdiv0(jpi,:) = 0._wp 96 ENDIF 106 97 107 108 ! Sub-time step loop 109 zconv = 1.e0 98 zconv = 1._wp !== horizontal diffusion using a Crant-Nicholson scheme ==! 110 99 iter = 0 111 112 ! !=================== 113 DO WHILE ( ( zconv > zeps ) .AND. (iter <= its) ) ! Sub-time step loop 114 ! !=================== 115 ! incrementation of the sub-time step number 116 iter = iter + 1 117 118 ! diffusive fluxes in U- and V- direction 119 DO jj = 1, jpjm1 100 ! 101 DO WHILE ( zconv > zeps .AND. iter <= its ) ! Sub-time step loop 102 ! 103 iter = iter + 1 ! incrementation of the sub-time step number 104 ! 105 DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction 120 106 DO ji = 1 , fs_jpim1 ! vector opt. 121 107 zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) … … 123 109 END DO 124 110 END DO 125 126 ! diffusive trend : divergence of the fluxes 127 DO jj= 2, jpjm1 111 ! 112 DO jj= 2, jpjm1 ! diffusive trend : divergence of the fluxes 128 113 DO ji = fs_2 , fs_jpim1 ! vector opt. 129 114 zdiv (ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj ) & … … 131 116 END DO 132 117 END DO 133 134 ! save the first evaluation of the diffusive trend in zdiv0 135 IF( iter == 1 ) zdiv0(:,:) = zdiv(:,:) 136 137 ! XXXX iterative evaluation????? 138 DO jj = 2, jpjm1 118 ! 119 IF( iter == 1 ) zdiv0(:,:) = zdiv(:,:) ! save the 1st evaluation of the diffusive trend in zdiv0 120 ! 121 DO jj = 2, jpjm1 ! iterative evaluation 139 122 DO ji = fs_2 , fs_jpim1 ! vector opt. 140 zrlxint = ( ptab0(ji,jj) &141 & + rdt_ice * ( zalfa * ( zdiv(ji,jj) + zfact(ji,jj) * ptab(ji,jj) ) &123 zrlxint = ( ztab0(ji,jj) & 124 & + rdt_ice * ( zalfa * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj) ) & 142 125 & + ( 1.0 - zalfa ) * zdiv0(ji,jj) ) ) & 143 & / ( 1.0 + zalfa * rdt_ice * zfact(ji,jj) )126 & / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) ) 144 127 zrlx(ji,jj) = ptab(ji,jj) + om * ( zrlxint - ptab(ji,jj) ) 145 128 END DO 146 129 END DO 130 CALL lbc_lnk( zrlx, 'T', 1. ) ! lateral boundary condition 147 131 148 ! lateral boundary condition on ptab 149 CALL lbc_lnk( zrlx, 'T', 1. ) 132 zconv = 0._wp ! convergence test 150 133 151 ! convergence test152 zconv = 0.e0153 134 DO jj = 2, jpjm1 154 135 DO ji = 2, jpim1 … … 156 137 END DO 157 138 END DO 158 IF( lk_mpp ) CALL mpp_max( zconv ) ! max over the global domain139 IF( lk_mpp ) CALL mpp_max( zconv ) ! max over the global domain 159 140 160 141 ptab(:,:) = zrlx(:,:) 161 162 ! !========================== 163 END DO ! end of sub-time step loop 164 ! !========================== 142 ! 143 END DO ! end of sub-time step loop 165 144 166 145 IF(ln_ctl) THEN 167 zrlx(:,:) = ptab(:,:) - ptab0(:,:)146 zrlx(:,:) = ptab(:,:) - ztab0(:,:) 168 147 WRITE(charout,FMT="(' lim_hdf : zconv =',D23.16, ' iter =',I4,2X)") zconv, iter 169 CALL prt_ctl( tab2d_1=zrlx, clinfo1=charout)148 CALL prt_ctl( tab2d_1=zrlx, clinfo1=charout ) 170 149 ENDIF 171 150 ! 151 IF( wrk_not_released(2, 11,12,13,14,15,16) ) CALL ctl_stop('lim_hdf_2: failed to release workspace arrays') 152 ! 172 153 END SUBROUTINE lim_hdf_2 173 154 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90
r2528 r2715 19 19 USE lbclnk 20 20 USE in_out_manager 21 USE lib_mpp ! MPP library 21 22 22 23 IMPLICIT NONE … … 45 46 !! ** Refer. : Deleersnijder et al. Ocean Modelling 100, 7-10 46 47 !!--------------------------------------------------------------------- 48 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 49 USE wrk_nemo, ONLY: zd2d1 => wrk_2d_1, zd1d2 => wrk_2d_2 47 50 INTEGER :: ji, jj ! dummy loop indices 48 51 REAL(wp) :: zusden ! local scalars … … 51 54 REAL(wp) :: zh1p , zh2p ! - - 52 55 REAL(wp) :: zd2d1p, zd1d2p ! - - 53 REAL(wp), DIMENSION(jpi,jpj) :: zd2d1 , zd1d2 ! 2D workspace54 56 #endif 55 57 !!--------------------------------------------------------------------- 58 59 IF( wrk_in_use(2, 1,2) ) THEN 60 CALL ctl_stop('lim_msh_2 : requested workspace arrays unavailable') ; RETURN 61 ENDIF 56 62 57 63 IF(lwp) THEN … … 275 281 area(:,:) = e1t(:,:) * e2t(:,:) 276 282 ! 283 IF( wrk_not_released(2, 1,2) ) CALL ctl_stop('lim_msh_2 : failed to release workspace arrays') 284 ! 277 285 END SUBROUTINE lim_msh_2 278 286 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90
r2528 r2715 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 INTEGER FUNCTION lim_rhg_alloc_2() 60 !!------------------------------------------------------------------- 61 !! *** FUNCTION lim_rhg_alloc_2 *** 62 !!------------------------------------------------------------------- 63 ALLOCATE( zu0(jpi,0:jpj+1), zv0(jpi,0:jpj+1), & 64 & zu_n(jpi,0:jpj+1), zv_n(jpi,0:jpj+1), & 65 & zu_a(jpi,0:jpj+1), zv_a(jpi,0:jpj+1), & 66 & zviszeta(jpi,0:jpj+1), zviseta(jpi,0:jpj+1), & 67 & zzfrld(jpi,0:jpj+1), zztms(jpi,0:jpj+1), & 68 & zi1(jpi,0:jpj+1), zi2(jpi,0:jpj+1), & 69 & zmasst(jpi,0:jpj+1), zpresh(jpi,0:jpj+1), & 70 & Stat=lim_rhg_alloc_2) 71 ! 72 IF( lim_rhg_alloc_2 /= 0 ) CALL ctl_warn('lim_rhg_alloc_2 : failed to allocate arrays') 73 ! 74 END FUNCTION lim_rhg_alloc_2 75 48 76 49 77 SUBROUTINE lim_rhg_2( k_j1, k_jpj ) … … 59 87 !! at I-point 60 88 !!------------------------------------------------------------------- 89 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 90 USE wrk_nemo, ONLY: zfrld => wrk_2d_1, zmass => wrk_2d_2, zcorl => wrk_2d_3 91 USE wrk_nemo, ONLY: za1ct => wrk_2d_4, za2ct => wrk_2d_5, zresr => wrk_2d_6 92 USE wrk_nemo, ONLY: zc1u => wrk_2d_7, zc1v => wrk_2d_8, zc2u => wrk_2d_9 93 USE wrk_nemo, ONLY: zc2v => wrk_2d_10, zsang => wrk_2d_11 94 !! 61 95 INTEGER, INTENT(in) :: k_j1 ! southern j-index for ice computation 62 96 INTEGER, INTENT(in) :: k_jpj ! northern j-index for ice computation … … 79 113 REAL(wp) :: zs21_11, zs21_12, zs21_21, zs21_22 80 114 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 115 !!------------------------------------------------------------------- 92 116 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r2566 r2715 9 9 !! 3.3 ! 2009-05 (G. Garric, C. Bricaud) addition of the lim2_evp case 10 10 !! - ! 2010-11 (G. Madec) ice-ocean stress computed at each ocean time-step 11 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 11 12 !!---------------------------------------------------------------------- 12 13 #if defined key_lim2 … … 14 15 !! 'key_lim2' LIM 2.0 sea-ice model 15 16 !!---------------------------------------------------------------------- 16 !! lim_sbc_flx_2 : update mass, heat and salt fluxes at the ocean surface 17 !! lim_sbc_tau_2 : update i- and j-stresses, and its modulus at the ocean surface 17 !! lim_sbc_alloc_2 : allocate the limsbc arrays 18 !! lim_sbc_init : initialisation 19 !! lim_sbc_flx_2 : update mass, heat and salt fluxes at the ocean surface 20 !! lim_sbc_tau_2 : update i- and j-stresses, and its modulus at the ocean surface 18 21 !!---------------------------------------------------------------------- 19 22 USE par_oce ! ocean parameters … … 27 30 USE albedo ! albedo parameters 28 31 USE lbclnk ! ocean lateral boundary condition - MPP exchanges 32 USE lib_mpp ! MPP library 29 33 USE in_out_manager ! I/O manager 30 34 USE diaar5, ONLY : lk_diaar5 … … 36 40 PRIVATE 37 41 38 PUBLIC lim_sbc_flx_2 ! called by sbc_ice_lim_2 39 PUBLIC lim_sbc_tau_2 ! called by sbc_ice_lim_2 42 PUBLIC lim_sbc_init_2 ! called by ice_init_2 43 PUBLIC lim_sbc_flx_2 ! called by sbc_ice_lim_2 44 PUBLIC lim_sbc_tau_2 ! called by sbc_ice_lim_2 40 45 41 46 REAL(wp) :: r1_rdtice ! = 1. / rdt_ice … … 44 49 REAL(wp) :: rone = 1._wp ! - - 45 50 ! 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]51 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: soce_0, sice_0 ! constant SSS and ice salinity used in levitating sea-ice case 52 53 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_oce, vtau_oce ! air-ocean surface i- & j-stress [N/m2] 54 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmod_io ! modulus of the ice-ocean relative velocity [m/s] 50 55 51 56 !! * Substitutions 52 57 # include "vectopt_loop_substitute.h90" 53 58 !!---------------------------------------------------------------------- 54 !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)59 !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011) 55 60 !! $Id$ 56 61 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 57 62 !!---------------------------------------------------------------------- 58 63 CONTAINS 64 65 INTEGER FUNCTION lim_sbc_alloc_2() 66 !!------------------------------------------------------------------- 67 !! *** ROUTINE lim_sbc_alloc_2 *** 68 !!------------------------------------------------------------------- 69 ALLOCATE( soce_0(jpi,jpj) , utau_oce(jpi,jpj) , & 70 & sice_0(jpi,jpj) , vtau_oce(jpi,jpj) , tmod_io(jpi,jpj), STAT=lim_sbc_alloc_2) 71 ! 72 IF( lk_mpp ) CALL mpp_sum( lim_sbc_alloc_2 ) 73 IF( lim_sbc_alloc_2 /= 0 ) CALL ctl_warn('lim_sbc_alloc_2: failed to allocate arrays.') 74 ! 75 END FUNCTION lim_sbc_alloc_2 76 59 77 60 78 SUBROUTINE lim_sbc_flx_2( kt ) … … 82 100 !! Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 83 101 !!--------------------------------------------------------------------- 102 USE wrk_nemo, ONLY: wrk_not_released, wrk_in_use 103 USE wrk_nemo, ONLY: zqnsoce => wrk_2d_1 ! 2D workspace 104 USE wrk_nemo, ONLY: wrk_3d_4, wrk_3d_5 84 105 INTEGER, INTENT(in) :: kt ! number of iteration 85 106 !! … … 90 111 REAL(wp) :: zqsr, zqns, zfm ! local scalars 91 112 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 113 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 94 114 !!--------------------------------------------------------------------- 95 115 96 IF( kt == nit000 ) THEN 97 IF(lwp) WRITE(numout,*) 98 IF(lwp) WRITE(numout,*) 'lim_sbc_flx_2 : LIM-2 sea-ice - surface boundary condition - Mass, heat & salt fluxes' 99 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ ' 100 ! 101 r1_rdtice = 1._wp / rdt_ice 102 ! 103 soce_0(:,:) = soce ! constant SSS and ice salinity used in levitating sea-ice case 104 sice_0(:,:) = sice 105 ! 106 IF( cp_cfg == "orca" ) THEN ! decrease ocean & ice reference salinities in the Baltic sea 107 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. & 108 & 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 109 soce_0(:,:) = 4._wp 110 sice_0(:,:) = 2._wp 111 END WHERE 112 ENDIF 113 ! 116 IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 4,5) )THEN 117 CALL ctl_stop('lim_sbc_flx_2 : requested workspace arrays unavailable') ; RETURN 114 118 ENDIF 119 zalb => wrk_3d_4(:,:,1:1) ! Set-up pointers to sub-arrays of 3d workspaces 120 zalbp => wrk_3d_5(:,:,1:1) 115 121 116 122 !------------------------------------------! … … 150 156 !!$! -> ice aera increases ??? -> ice aera decreases ??? 151 157 !!$ 152 !!$ iadv = ( 1 - i1mfr ) * zinda 158 !!$ iadv = ( 1 - i1mfr ) * zinda 153 159 !!$! pure ocean ice at 154 160 !!$! at current previous … … 159 165 !!$! current 160 166 !!$! -> ??? 161 !!$ 162 !!$ ifrdv = ( 1 - ifral * ( 1 - ial ) ) * iadv 163 !!$! ice disapear 167 !!$ 168 !!$ ifrdv = ( 1 - ifral * ( 1 - ial ) ) * iadv 169 !!$! ice disapear 164 170 !!$ 165 171 !!$ … … 229 235 230 236 IF( lk_cpl ) THEN ! coupled case 231 ! Ice surface temperature232 237 tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature 233 ! Computation of snow/ice and ocean albedo238 ! ! Computation of snow/ice and ocean albedo 234 239 CALL albedo_ice( tn_ice, reshape( hicif, (/jpi,jpj,1/) ), reshape( hsnif, (/jpi,jpj,1/) ), zalbp, zalb ) 235 240 alb_ice(:,:,1) = 0.5 * ( zalbp(:,:,1) + zalb (:,:,1) ) ! Ice albedo (mean clear and overcast skys) … … 244 249 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' lim_sbc: fr_i : ', tab2d_2=tn_ice(:,:,1), clinfo2=' tn_ice : ') 245 250 ENDIF 251 ! 252 IF( wrk_not_released(2, 1) .OR. & 253 wrk_not_released(3, 4,5) ) CALL ctl_stop('lim_sbc_flx_2 : failed to release workspace arrays') 246 254 ! 247 255 END SUBROUTINE lim_sbc_flx_2 … … 274 282 !! - taum : modulus of the surface ocean stress (T-point) updated with ice-ocean fluxes 275 283 !!--------------------------------------------------------------------- 284 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 285 USE wrk_nemo, ONLY: ztio_u => wrk_2d_1, ztio_v => wrk_2d_2 ! ocean stress below sea-ice 276 286 INTEGER , INTENT(in) :: kt ! ocean time-step index 277 287 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pu_oce, pv_oce ! surface ocean currents … … 281 291 REAL(wp) :: zfrldv, zat_v, zv_i, zvtau_ice, zv_t, zmodi ! - - 282 292 REAL(wp) :: zsang, zumt ! - - 283 REAL(wp), DIMENSION(jpi,jpj) :: ztio_u, ztio_v ! ocean stress below sea-ice284 293 !!--------------------------------------------------------------------- 285 294 ! 286 IF( kt == nit000 .AND. lwp ) THEN ! control print 287 WRITE(numout,*) 288 WRITE(numout,*) 'lim_sbc_tau_2 : LIM 2.0 sea-ice - surface ocean momentum fluxes' 289 WRITE(numout,*) '~~~~~~~~~~~~~ ' 290 IF( lk_lim2_vp ) THEN ; WRITE(numout,*) ' VP rheology - B-grid case' 291 ELSE ; WRITE(numout,*) ' EVP rheology - C-grid case' 292 ENDIF 295 IF( wrk_in_use(2, 1,2) ) THEN 296 CALL ctl_stop('lim_sbc_tau_2 : requested workspace arrays unavailable.') ; RETURN 293 297 ENDIF 294 298 ! … … 405 409 & tab2d_2=vtau, clinfo2=' vtau : ' , mask2=vmask ) 406 410 ! 411 IF( wrk_not_released(2, 1,2) ) CALL ctl_stop('lim_sbc_tau_2 : failed to release workspace arrays') 412 ! 407 413 END SUBROUTINE lim_sbc_tau_2 414 415 416 SUBROUTINE lim_sbc_init_2 417 !!------------------------------------------------------------------- 418 !! *** ROUTINE lim_sbc_init *** 419 !! 420 !! ** Purpose : Preparation of the file ice_evolu for the output of 421 !! the temporal evolution of key variables 422 !! 423 !! ** input : Namelist namicedia 424 !!------------------------------------------------------------------- 425 ! 426 IF(lwp) WRITE(numout,*) 427 IF(lwp) WRITE(numout,*) 'lim_sbc_init_2 : LIM-2 sea-ice - surface boundary condition' 428 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~ ' 429 430 ! ! allocate lim_sbc arrays 431 IF( lim_sbc_alloc_2() /= 0 ) CALL ctl_stop( 'STOP', 'lim_sbc_flx_2 : unable to allocate arrays' ) 432 ! 433 r1_rdtice = 1._wp / rdt_ice 434 ! 435 soce_0(:,:) = soce ! constant SSS and ice salinity used in levitating sea-ice case 436 sice_0(:,:) = sice 437 ! 438 IF( cp_cfg == "orca" ) THEN ! decrease ocean & ice reference salinities in the Baltic sea 439 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. & 440 & 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 441 soce_0(:,:) = 4._wp 442 sice_0(:,:) = 2._wp 443 END WHERE 444 ENDIF 445 ! 446 END SUBROUTINE lim_sbc_init_2 408 447 409 448 #else -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limtab_2.F90
r2528 r2715 2 2 !!====================================================================== 3 3 !! *** MODULE limtab_2 *** 4 !! 4 !! LIM : transform 1D (2D) array to a 2D (1D) table 5 5 !!====================================================================== 6 6 #if defined key_lim2 7 7 !!---------------------------------------------------------------------- 8 !! tab_2d_1d : 2-D to1-D9 !! tab_1d_2d : 1-D to2-D8 !! tab_2d_1d : 2-D <==> 1-D 9 !! tab_1d_2d : 1-D <==> 2-D 10 10 !!---------------------------------------------------------------------- 11 !! * Modules used12 11 USE par_kind 13 12 … … 15 14 PRIVATE 16 15 17 !! * Routine accessibility 18 PUBLIC tab_2d_1d_2 ! called by lim_ther 19 PUBLIC tab_1d_2d_2 ! called by lim_ther 16 PUBLIC tab_2d_1d_2 ! called by limthd 17 PUBLIC tab_1d_2d_2 ! called by limthd 20 18 21 19 !!---------------------------------------------------------------------- 22 !! NEMO/LIM2 3.3, UCL - NEMO Consortium (2010)20 !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2010) 23 21 !! $Id$ 24 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)22 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 25 23 !!---------------------------------------------------------------------- 26 24 CONTAINS 27 25 28 26 SUBROUTINE tab_2d_1d_2 ( ndim1d, tab1d, tab2d, ndim2d_x, ndim2d_y, tab_ind ) 29 30 INTEGER, INTENT(in) :: & 31 ndim1d, ndim2d_x, ndim2d_y 32 33 REAL(wp), DIMENSION (ndim2d_x, ndim2d_y), INTENT(in) :: & 34 tab2d 35 36 INTEGER, DIMENSION ( ndim1d), INTENT ( in) :: & 37 tab_ind 38 39 REAL(wp), DIMENSION(ndim1d), INTENT ( out) :: & 40 tab1d 41 42 INTEGER :: & 43 jn , jid, jjd 44 27 !!---------------------------------------------------------------------- 28 !! *** ROUTINE tab_2d_1d *** 29 !!---------------------------------------------------------------------- 30 INTEGER , INTENT(in ) :: ndim1d, ndim2d_x, ndim2d_y ! 1D & 2D sizes 31 REAL(wp), DIMENSION(ndim2d_x,ndim2d_y), INTENT(in ) :: tab2d ! input 2D field 32 INTEGER , DIMENSION(ndim1d) , INTENT(in ) :: tab_ind ! input index 33 REAL(wp), DIMENSION(ndim1d) , INTENT( out) :: tab1d ! output 1D field 34 ! 35 INTEGER :: jn , jid, jjd 36 !!---------------------------------------------------------------------- 45 37 DO jn = 1, ndim1d 46 jid = MOD( tab_ind(jn) - 1 , ndim2d_x ) + 147 jjd = ( tab_ind(jn) - 1 ) / ndim2d_x + 138 jid = MOD( tab_ind(jn) - 1 , ndim2d_x ) + 1 39 jjd = ( tab_ind(jn) - 1 ) / ndim2d_x + 1 48 40 tab1d( jn) = tab2d( jid, jjd) 49 41 END DO 50 51 42 END SUBROUTINE tab_2d_1d_2 52 43 53 44 54 45 SUBROUTINE tab_1d_2d_2 ( ndim1d, tab2d, tab_ind, tab1d, ndim2d_x, ndim2d_y ) 55 56 INTEGER, INTENT ( in) :: & 57 ndim1d, ndim2d_x, ndim2d_y 58 59 INTEGER, DIMENSION (ndim1d) , INTENT (in) :: & 60 tab_ind 61 62 REAL(wp), DIMENSION(ndim1d), INTENT (in) :: & 63 tab1d 64 65 REAL(wp), DIMENSION (ndim2d_x, ndim2d_y), INTENT ( out) :: & 66 tab2d 67 68 INTEGER :: & 69 jn, jid, jjd 70 46 !!---------------------------------------------------------------------- 47 !! *** ROUTINE tab_2d_1d *** 48 !!---------------------------------------------------------------------- 49 INTEGER , INTENT(in ) :: ndim1d, ndim2d_x, ndim2d_y ! 1d & 2D sizes 50 REAL(wp), DIMENSION(ndim1d) , INTENT(in ) :: tab1d ! input 1D field 51 INTEGER , DIMENSION(ndim1d) , INTENT(in ) :: tab_ind ! input index 52 REAL(wp), DIMENSION(ndim2d_x,ndim2d_y), INTENT( out) :: tab2d ! output 2D field 53 ! 54 INTEGER :: jn , jid, jjd 55 !!---------------------------------------------------------------------- 71 56 DO jn = 1, ndim1d 72 jid = MOD( tab_ind(jn) - 1 , ndim2d_x) + 157 jid = MOD( tab_ind(jn) - 1 , ndim2d_x ) + 1 73 58 jjd = ( tab_ind(jn) - 1 ) / ndim2d_x + 1 74 59 tab2d(jid, jjd) = tab1d( jn) 75 60 END DO 76 77 61 END SUBROUTINE tab_1d_2d_2 78 62 63 #else 64 !!---------------------------------------------------------------------- 65 !! Default option Dummy module NO LIM sea-ice model 66 !!---------------------------------------------------------------------- 79 67 #endif 68 !!====================================================================== 80 69 END MODULE limtab_2 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
r2528 r2715 75 75 !! References : Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 76 76 !!--------------------------------------------------------------------- 77 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 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( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10) .OR. & 119 wrk_in_use(3, 4) ) THEN 120 CALL ctl_stop('lim_thd_2 : requested workspace arrays unavailable') ; RETURN 121 ENDIF 114 122 115 123 IF( kt == nit000 ) CALL lim_thd_init_2 ! Initialization (first time-step only) … … 512 520 ENDIF 513 521 ! 522 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10) .OR. & 523 wrk_not_released(3, 4) ) THEN 524 CALL ctl_stop('lim_thd_2 : failed to release workspace arrays') 525 ENDIF 526 ! 514 527 END SUBROUTINE lim_thd_2 515 528 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90
r2528 r2715 7 7 8 8 !!---------------------------------------------------------------------- 9 !! lim_lat_acr_2 10 !! * Modules used9 !! lim_lat_acr_2 : lateral accretion of ice 10 !!---------------------------------------------------------------------- 11 11 USE par_oce ! ocean parameters 12 12 USE phycst … … 14 14 USE ice_2 15 15 USE limistate_2 16 16 USE lib_mpp ! MPP library 17 17 18 IMPLICIT NONE 18 19 PRIVATE 19 20 20 !! * Routine accessibility 21 PUBLIC lim_thd_lac_2 ! called by lim_thd_2 22 23 !! * Module variables 21 PUBLIC lim_thd_lac_2 ! called by lim_thd_2 22 24 23 REAL(wp) :: & ! constant values 25 24 epsi20 = 1.e-20 , & … … 27 26 zzero = 0.e0 , & 28 27 zone = 1.e0 28 29 29 !!---------------------------------------------------------------------- 30 30 !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) … … 68 68 !! 2.0 ! 02-08 (C. Ethe, G. Madec) F90, mpp 69 69 !!------------------------------------------------------------------- 70 !! * Arguments 70 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 71 USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_2, wrk_1d_3, wrk_1d_4, wrk_1d_5, wrk_1d_6 72 ! 71 73 INTEGER , INTENT(IN):: & 72 74 kideb , & ! start point on which the the computation is applied 73 75 kiut ! end point on which the the computation is applied 74 76 75 ! !* Local variables77 ! * Local variables 76 78 INTEGER :: & 77 79 ji , & ! dummy loop indices … … 79 81 iiceform , & ! 1 = ice formed ; 0 = no ice formed 80 82 ihemis ! dummy indice 81 REAL(wp), DIMENSION(jpij) :: &83 REAL(wp), POINTER, DIMENSION(:) :: & 82 84 zqbgow , & ! heat budget of the open water (negative) 83 85 zfrl_old , & ! previous sea/ice fraction … … 101 103 zah, zalpha , zbeta 102 104 !!--------------------------------------------------------------------- 103 105 106 IF( wrk_in_use(1, 1,2,3,4,5,6) ) THEN 107 CALL ctl_stop('lim_thd_lac_2 : requestead workspace arrays unavailable') ; RETURN 108 ENDIF 109 ! Set-up pointers to sub-arrays of workspace arrays 110 zqbgow => wrk_1d_1(1:jpij) 111 zfrl_old => wrk_1d_2(1:jpij) 112 zhice_old => wrk_1d_3(1:jpij) 113 zhice0 => wrk_1d_4(1:jpij) 114 zfrlmin => wrk_1d_5(1:jpij) 115 zdhicbot => wrk_1d_6(1:jpij) 116 104 117 !-------------------------------------------------------------- 105 118 ! Computation of the heat budget of the open water (negative) … … 219 232 END DO 220 233 234 IF( wrk_not_released(1, 1,2,3,4,5,6) ) CALL ctl_stop('lim_thd_lac_2 : failed to release workspace arrays.') 235 ! 221 236 END SUBROUTINE lim_thd_lac_2 222 237 #else 223 !! ======================================================================238 !!---------------------------------------------------------------------- 224 239 !! *** MODULE limthd_lac_2 *** 225 240 !! no sea ice model 226 !! ======================================================================241 !!---------------------------------------------------------------------- 227 242 CONTAINS 228 243 SUBROUTINE lim_thd_lac_2 ! Empty routine 229 244 END SUBROUTINE lim_thd_lac_2 230 245 #endif 246 !!====================================================================== 231 247 END MODULE limthd_lac_2 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
r2528 r2715 11 11 !! 'key_lim2' LIM 2.0 sea-ice model 12 12 !!---------------------------------------------------------------------- 13 !!----------------------------------------------------------------------14 13 !! lim_thd_zdf_2 : vertical accr./abl. and lateral ablation of sea ice 15 14 !!---------------------------------------------------------------------- 16 !! * Modules used17 15 USE par_oce ! ocean parameters 18 16 USE phycst ! ??? … … 21 19 USE limistate_2 22 20 USE in_out_manager 21 USE lib_mpp ! MPP library 23 22 USE cpl_oasis3, ONLY : lk_cpl 24 23 … … 35 34 !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 36 35 !! $Id$ 37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 38 37 !!---------------------------------------------------------------------- 39 40 38 CONTAINS 41 39 … … 69 67 !! Fichefet T. and M. Maqueda 1999, Clim. Dyn, 15(4), 251-268 70 68 !!------------------------------------------------------------------ 69 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 70 USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_2, wrk_1d_3, wrk_1d_4, wrk_1d_5 71 USE wrk_nemo, ONLY: wrk_1d_6, wrk_1d_7, wrk_1d_8, wrk_1d_9, wrk_1d_10 72 USE wrk_nemo, ONLY: wrk_1d_11, wrk_1d_12, wrk_1d_13, wrk_1d_14, wrk_1d_15 73 USE wrk_nemo, ONLY: wrk_1d_16, wrk_1d_17, wrk_1d_18, wrk_1d_19, wrk_1d_20 74 USE wrk_nemo, ONLY: wrk_1d_21, wrk_1d_22, wrk_1d_23, wrk_1d_24, wrk_1d_25 75 USE wrk_nemo, ONLY: wrk_1d_26, wrk_1d_27 76 !! 71 77 INTEGER, INTENT(in) :: kideb ! Start point on which the the computation is applied 72 78 INTEGER, INTENT(in) :: kiut ! End point on which the the computation is applied 73 79 !! 74 80 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) :: & 81 REAL(wp), POINTER, DIMENSION(:) :: zqcmlts ! energy due to surface melting 82 REAL(wp), POINTER, DIMENSION(:) :: zqcmltb ! energy due to bottom melting 83 REAL(wp), POINTER, DIMENSION(:) :: & 77 84 ztsmlt & ! snow/ice surface melting temperature 78 85 ,ztbif & ! int. temp. at the mid-point of the 1st layer of the snow/ice sys. … … 88 95 , zts_old & ! previous surface temperature 89 96 , zidsn , z1midsn , zidsnic ! tempory variables 90 REAL(wp), DIMENSION(jpij) :: &97 REAL(wp), POINTER, DIMENSION(:) :: & 91 98 zfnet & ! net heat flux at the top surface( incl. conductive heat flux) 92 99 , zsprecip & ! snow accumulation … … 160 167 !!---------------------------------------------------------------------- 161 168 169 IF(wrk_in_use(1, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, & 170 & 11,12,13,14,15,16,17,18,19,20, & 171 & 21,22,23,24,25,26,27) ) THEN 172 CALL ctl_stop('lim_thd_zdf_2 : requested workspace arrays unavailable') ; RETURN 173 ENDIF 174 175 ztsmlt => wrk_1d_1(1:jpij) 176 ztbif => wrk_1d_2(1:jpij) 177 zksn => wrk_1d_3(1:jpij) 178 zkic => wrk_1d_4(1:jpij) 179 zksndh => wrk_1d_5(1:jpij) 180 zfcsu => wrk_1d_6(1:jpij) 181 zfcsudt => wrk_1d_7(1:jpij) 182 zi0 => wrk_1d_8(1:jpij) 183 z1mi0 => wrk_1d_9(1:jpij) 184 zqmax => wrk_1d_10(1:jpij) 185 zrcpdt => wrk_1d_11(1:jpij) 186 zts_old => wrk_1d_12(1:jpij) 187 zidsn => wrk_1d_13(1:jpij) 188 z1midsn => wrk_1d_14(1:jpij) 189 zidsnic => wrk_1d_15(1:jpij) 190 191 zfnet => wrk_1d_16(1:jpij) 192 zsprecip => wrk_1d_17(1:jpij) 193 zhsnw_old => wrk_1d_18(1:jpij) 194 zdhictop => wrk_1d_19(1:jpij) 195 zdhicbot => wrk_1d_20(1:jpij) 196 zqsup => wrk_1d_21(1:jpij) 197 zqocea => wrk_1d_22(1:jpij) 198 zfrl_old => wrk_1d_23(1:jpij) 199 zfrld_1d => wrk_1d_24(1:jpij) 200 zep => wrk_1d_25(1:jpij) 201 202 zqcmlts => wrk_1d_26(1:jpij) 203 zqcmltb => wrk_1d_27(1:jpij) 204 162 205 !----------------------------------------------------------------------- 163 206 ! 1. Boundaries conditions for snow/ice system internal temperature … … 171 214 zihic = MAX( zzero , SIGN( zone , hicdif - h_ice_1d(ji) ) ) 172 215 !--computation of energy due to surface melting 173 zqcmlt (ji,1) = ( MAX ( zzero , &216 zqcmlts(ji) = ( MAX ( zzero , & 174 217 & rcpsn * h_snow_1d(ji) * ( tbif_1d(ji,1) - rt0_snow ) ) ) * ( 1.0 - zihsn ) 175 218 !--computation of energy due to bottom melting 176 zqcmlt (ji,2) = ( MAX( zzero , &219 zqcmltb(ji) = ( MAX( zzero , & 177 220 & rcpic * ( tbif_1d(ji,2) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) & 178 221 & + MAX( zzero , & … … 467 510 zhsnw_old(ji) = h_snow_1d(ji) 468 511 !--computation of the energy needed to melt snow 469 zqsnw_mlt = zfnet(ji) * rdt_ice - zqcmlt (ji,1)512 zqsnw_mlt = zfnet(ji) * rdt_ice - zqcmlts(ji) 470 513 !--change in snow thickness due to melt 471 514 zdhsmlt = - zqsnw_mlt / xlsn … … 587 630 588 631 !---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) )632 zqice_bot = zibmlt * ( zqice_bot_mlt - zqcmltb(ji) ) & 633 & + ( 1.0 - zibmlt ) * ( zqice_bot - zqcmltb(ji) ) 591 634 qstbif_1d(ji) = zibmlt * qstbif_1d(ji) & 592 635 & + ( 1.0 - zibmlt ) * zqstbif_bot … … 762 805 END DO 763 806 ! 807 IF( wrk_not_released(1, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, & 808 & 11,12,13,14,15,16,17,18,19,20, & 809 & 21,22,23,24,25,26,27) ) & 810 CALL ctl_stop('lim_thd_zdf_2 : failed to release workspace arrays.') 811 ! 764 812 END SUBROUTINE lim_thd_zdf_2 765 813 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90
r2528 r2715 63 63 !! ** action : 64 64 !!--------------------------------------------------------------------- 65 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 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( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10) ) THEN 82 CALL ctl_stop('lim_trp_2 : requested workspace arrays unavailable') ; RETURN 83 ENDIF 77 84 78 85 IF( kt == nit000 ) CALL lim_trp_init_2 ! Initialization (first time-step only) … … 266 273 ENDIF 267 274 ! 275 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10) ) CALL ctl_stop('lim_trp_2 : failed to release workspace arrays') 276 ! 268 277 END SUBROUTINE lim_trp_2 269 278 -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90
r2528 r2715 26 26 USE ice_2 27 27 28 USE dianam ! build name of file (routine) 28 29 USE lbclnk 29 USE dianam ! build name of file (routine)30 30 USE in_out_manager 31 USE lib_mpp ! MPP library 31 32 USE iom 32 33 USE ioipsl … … 39 40 #endif 40 41 PUBLIC lim_wri_state_2 ! called by dia_wri_state 42 PUBLIC lim_wri_alloc_2 ! called by nemogcm.F90 41 43 42 44 INTEGER, PARAMETER :: jpnoumax = 40 ! maximum number of variable for ice output … … 50 52 51 53 INTEGER :: nice, nhorid, ndim, niter, ndepid ! ???? 52 INTEGER , DIMENSION( jpij ) :: ndex51 ! ???? 53 54 REAL(wp) :: & ! constant values 55 epsi16 = 1.e-16 , & 56 zzero = 0.e0 , & 57 zone = 1.e0 54 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex51 ! ???? 55 56 REAL(wp) :: epsi16 = 1.e-16_wp ! constant values 57 REAL(wp) :: zzero = 0._wp ! - - 58 REAL(wp) :: zone = 1._wp ! - - 59 60 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcmo ! Workspace array for netcdf writer. 61 58 62 59 63 !! * Substitutions … … 64 68 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 65 69 !!---------------------------------------------------------------------- 66 67 70 CONTAINS 71 72 INTEGER FUNCTION lim_wri_alloc_2() 73 !!------------------------------------------------------------------- 74 !! *** ROUTINE lim_wri_alloc_2 *** 75 !!------------------------------------------------------------------- 76 ALLOCATE( ndex51(jpij), zcmo(jpi,jpj,jpnoumax), STAT=lim_wri_alloc_2) 77 ! 78 IF( lk_mpp ) CALL mpp_sum ( lim_wri_alloc_2 ) 79 IF( lim_wri_alloc_2 /= 0 ) CALL ctl_warn('lim_wri_alloc_2: failed to allocate array ndex51') 80 ! 81 END FUNCTION lim_wri_alloc_2 82 68 83 69 84 #if ! defined key_iomput … … 85 100 !! of a day 86 101 !!------------------------------------------------------------------- 102 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 103 USE wrk_nemo, ONLY: zfield => wrk_2d_1 104 !! 87 105 INTEGER, INTENT(in) :: kt ! number of iteration 88 106 !! … … 92 110 & zindh, zinda, zindb, ztmu 93 111 REAL(wp), DIMENSION(1) :: zdept 94 REAL(wp), DIMENSION(jpi,jpj) :: zfield 95 REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: zcmo 96 !!------------------------------------------------------------------- 112 !!------------------------------------------------------------------- 113 114 IF( wrk_in_use(2, 1) ) THEN 115 CALL ctl_stop('lim_wri_2 : requested workspace array unavailable') ; RETURN 116 ENDIF 97 117 !--------------------! 98 118 IF( kt == nit000 ) THEN ! Initialisation ! 99 119 ! !--------------------! 120 100 121 CALL lim_wri_init_2 101 122 … … 186 207 IF( ( nn_fsbc * niter ) >= nitend ) CALL histclo( nice ) 187 208 209 IF( wrk_not_released(2, 1) ) CALL ctl_stop('lim_wri_2 : failed to release workspace array.') 210 ! 188 211 END SUBROUTINE lim_wri_2 189 212 … … 222 245 field_19 223 246 !!------------------------------------------------------------------- 247 ! 248 IF( lim_wri_alloc_2() /= 0 ) THEN ! allocate lim_wri arrrays 249 CALL ctl_stop( 'STOP', 'lim_wri_init_2 : unable to allocate standard arrays' ) ; RETURN 250 ENDIF 224 251 225 252 REWIND ( numnam_ice ) ! Read Namelist namicewri -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90
r2528 r2715 18 18 INTEGER, INTENT(in) :: kt ! number of iteration 19 19 20 REAL(wp),DIMENSION(1) :: zdept 20 INTEGER , SAVE :: nmoyice !: counter for averaging 21 INTEGER , SAVE :: nwf !: number of fields to write on disk 22 INTEGER , SAVE, DIMENSION(:), ALLOCATABLE :: nsubindex !: subindex to be saved 23 INTEGER , SAVE :: nice, nhorid, ndim, niter, ndepid 24 REAL(wp), SAVE, DIMENSION(jpi,jpj,jpnoumax) :: rcmoy 21 25 22 REAL(wp) :: & 23 zsto, zsec, zjulian,zout, & 24 zindh,zinda,zindb, & 25 ztmu 26 REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: & 27 zcmo 28 REAL(wp), DIMENSION(jpi,jpj) :: & 29 zfield 30 INTEGER, SAVE :: nmoyice, & !: counter for averaging 31 & nwf !: number of fields to write on disk 32 INTEGER, SAVE,DIMENSION (:), ALLOCATABLE :: nsubindex !: subindex to be saved 33 ! according to namelist 26 INTEGER :: ji, jj, jf, ii ! dummy loop indices and array index 27 INTEGER :: iyear, iday, imon ! 28 CHARACTER(LEN=80) :: clname, cltext, clmode 29 REAL(wp), DIMENSION(1) :: zdept 30 REAL(wp) :: zsto, zsec, zjulian,zout 31 REAL(wp) :: zindh,zinda,zindb, ztmu 32 REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: zcmo !ARPDBGWORK 33 REAL(wp), DIMENSION(jpi,jpj) :: zfield 34 34 35 REAL(wp), SAVE, DIMENSION(jpi,jpj,jpnoumax) :: rcmoy36 35 #if ! defined key_diainstant 37 36 LOGICAL, PARAMETER :: ll_dia_inst=.false. ! local logical variable … … 39 38 LOGICAL, PARAMETER :: ll_dia_inst=.true. 40 39 #endif 41 INTEGER :: ji, jj, jf, ii ! dummy loop indices and array index 42 INTEGER :: iyear, iday, imon ! 40 !!------------------------------------------------------------------- 43 41 44 CHARACTER(LEN=80) :: clname, cltext, clmode 45 46 47 INTEGER , SAVE :: & 48 nice, nhorid, ndim, niter, ndepid 49 INTEGER , DIMENSION( jpij ) , SAVE :: & 50 ndex51 51 !!------------------------------------------------------------------- 52 IF ( kt == nit000 ) THEN 53 42 IF( kt == nit000 ) THEN 43 ! 54 44 CALL lim_wri_init_2 55 45 … … 57 47 ii = 0 58 48 59 IF 49 IF(lwp ) THEN 60 50 WRITE(numout,*) 'lim_wri_2 : Write ice outputs in dimg' 61 51 WRITE(numout,*) '~~~~~~~~' -
trunk/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90
r2528 r2715 12 12 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 13 13 !!---------------------------------------------------------------------- 14 !! * Modules used15 14 USE par_ice_2 16 15 17 16 IMPLICIT NONE 18 17 PRIVATE 18 19 PUBLIC thd_ice_alloc_2 ! Routine called by nemogcm.F90 19 20 20 21 !! * Share Module variables … … 43 44 cnscg !: ratio rcpsn/rcpic 44 45 45 INTEGER , PUBLIC, DIMENSION(jpij) :: & !:46 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: & !: 46 47 npb , & !: number of points where computations has to be done 47 48 npac !: correspondance between the points 48 49 49 REAL(wp), PUBLIC, DIMENSION(jpij) :: & !:50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: & !: 50 51 qldif_1d , & !: corresponding to the 2D var qldif 51 52 qcmif_1d , & !: corresponding to the 2D var qcmif … … 80 81 dqla_ice_1d !: " " dqla_ice 81 82 82 REAL(wp), PUBLIC, DIMENSION(jpij,jplayersp1) :: & !:83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: & !: 83 84 tbif_1d !: corresponding to the 2D var tbif 84 85 86 !!---------------------------------------------------------------------- 87 !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 88 !! $Id$ 89 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 90 !!---------------------------------------------------------------------- 91 CONTAINS 92 93 INTEGER FUNCTION thd_ice_alloc_2() 94 !!---------------------------------------------------------------------- 95 USE lib_mpp ! MPP library 96 INTEGER :: ierr(4) 97 !!---------------------------------------------------------------------- 98 ! 99 ierr(:) = 0 100 ! 101 ALLOCATE( npb(jpij), npac(jpij), & 102 & qldif_1d(jpij), qcmif_1d(jpij), thcm_1d(jpij), & 103 & fstbif_1d(jpij), fltbif_1d(jpij), fscbq_1d(jpij), & 104 & qsr_ice_1d(jpij),fr1_i0_1d(jpij), fr2_i0_1d(jpij), Stat=ierr(1)) 105 ! 106 ALLOCATE( qns_ice_1d(jpij), qfvbq_1d(jpij), sist_1d(jpij), tfu_1d(jpij), & 107 & sprecip_1d(jpij), h_snow_1d(jpij),h_ice_1d(jpij),frld_1d(jpij),& 108 & qstbif_1d(jpij), fbif_1d(jpij), Stat=ierr(2)) 109 ! 110 ALLOCATE( rdmicif_1d(jpij), rdmsnif_1d(jpij), qlbbq_1d(jpij), & 111 & dmgwi_1d(jpij) , dvsbq_1d(jpij) , rdvomif_1d(jpij), & 112 & dvbbq_1d(jpij) , dvlbq_1d(jpij) , dvnbq_1d(jpij) , & 113 & Stat=ierr(3)) 114 ! 115 ALLOCATE( dqns_ice_1d(jpij) ,qla_ice_1d(jpij), dqla_ice_1d(jpij), & 116 & tbif_1d(jpij, jplayersp1), Stat=ierr(4)) 117 ! 118 thd_ice_alloc_2 = MAXVAL(ierr) 119 IF( thd_ice_alloc_2 /= 0 ) CALL ctl_warn('thd_ice_alloc_2: failed to allocate arrays') 120 ! 121 END FUNCTION thd_ice_alloc_2 122 123 #endif 85 124 !!====================================================================== 86 #endif87 125 END MODULE thd_ice_2
Note: See TracChangeset
for help on using the changeset viewer.
