Changeset 14064 for NEMO/trunk/src/OCE/ISF
- Timestamp:
- 2020-12-03T18:01:12+01:00 (3 years ago)
- Location:
- NEMO/trunk/src/OCE/ISF
- Files:
-
- 3 edited
-
isf_oce.F90 (modified) (9 diffs)
-
isfload.F90 (modified) (10 diffs)
-
isfstp.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/ISF/isf_oce.F90
r13558 r14064 1 1 MODULE isf_oce 2 2 !!====================================================================== 3 !! *** MODULE sbcisf***4 !! Surface module : compute iceshelf melt and heat flux3 !! *** MODULE isf_oce *** 4 !! Ice shelves : ice shelves variables defined in memory 5 5 !!====================================================================== 6 6 !! History : 3.2 ! 2011-02 (C.Harris ) Original code isf cav … … 146 146 END SUBROUTINE isf_alloc_par 147 147 148 148 149 SUBROUTINE isf_alloc_cav() 149 150 !!--------------------------------------------------------------------- … … 173 174 END SUBROUTINE isf_alloc_cav 174 175 176 175 177 SUBROUTINE isf_alloc_cpl() 176 178 !!--------------------------------------------------------------------- … … 184 186 ierr = 0 185 187 ! 186 ALLOCATE( risfcpl_ssh(jpi,jpj) , risfcpl_tsc(jpi,jpj,jpk,jpts), risfcpl_vol(jpi,jpj,jpk), STAT=ialloc )187 ierr = ierr + ialloc 188 ! 189 risfcpl_tsc(:,:,:,:) = 0. 0 ; risfcpl_vol(:,:,:) = 0.0 ; risfcpl_ssh(:,:) = 0.0190 191 IF ( ln_isfcpl_cons ) THEN192 ALLOCATE( risfcpl_cons_tsc(jpi,jpj,jpk,jpts) , risfcpl_cons_vol(jpi,jpj,jpk) , risfcpl_cons_ssh(jpi,jpj), STAT=ialloc )188 ALLOCATE( risfcpl_ssh(jpi,jpj) , risfcpl_tsc(jpi,jpj,jpk,jpts) , risfcpl_vol(jpi,jpj,jpk) , STAT=ialloc ) 189 ierr = ierr + ialloc 190 ! 191 risfcpl_tsc(:,:,:,:) = 0._wp ; risfcpl_vol(:,:,:) = 0._wp ; risfcpl_ssh(:,:) = 0._wp 192 193 IF ( ln_isfcpl_cons ) THEN 194 ALLOCATE( risfcpl_cons_tsc(jpi,jpj,jpk,jpts) , risfcpl_cons_vol(jpi,jpj,jpk) , risfcpl_cons_ssh(jpi,jpj) , STAT=ialloc ) 193 195 ierr = ierr + ialloc 194 196 ! 195 risfcpl_cons_tsc(:,:,:,:) = 0. 0 ; risfcpl_cons_vol(:,:,:) = 0.0 ; risfcpl_cons_ssh(:,:) = 0.0197 risfcpl_cons_tsc(:,:,:,:) = 0._wp ; risfcpl_cons_vol(:,:,:) = 0._wp ; risfcpl_cons_ssh(:,:) = 0._wp 196 198 ! 197 199 END IF … … 202 204 END SUBROUTINE isf_alloc_cpl 203 205 206 204 207 SUBROUTINE isf_dealloc_cpl() 205 208 !!--------------------------------------------------------------------- … … 213 216 ierr = 0 214 217 ! 215 DEALLOCATE( risfcpl_ssh , risfcpl_tsc, risfcpl_vol, STAT=ialloc )218 DEALLOCATE( risfcpl_ssh , risfcpl_tsc , risfcpl_vol , STAT=ialloc ) 216 219 ierr = ierr + ialloc 217 220 ! … … 221 224 END SUBROUTINE isf_dealloc_cpl 222 225 226 223 227 SUBROUTINE isf_alloc() 224 228 !!--------------------------------------------------------------------- … … 233 237 ierr = 0 ! set to zero if no array to be allocated 234 238 ! 235 ALLOCATE( fwfisf_par(jpi,jpj) , fwfisf_par_b(jpi,jpj),&236 & fwfisf_cav(jpi,jpj) , fwfisf_cav_b(jpi,jpj),&237 & fwfisf_oasis(jpi,jpj),STAT=ialloc )238 ierr = ierr + ialloc 239 ! 240 ALLOCATE( risf_par_tsc(jpi,jpj,jpts), risf_par_tsc_b(jpi,jpj,jpts), STAT=ialloc )241 ierr = ierr + ialloc 242 ! 243 ALLOCATE( risf_cav_tsc(jpi,jpj,jpts), risf_cav_tsc_b(jpi,jpj,jpts), STAT=ialloc )244 ierr = ierr + ialloc 245 ! 246 ALLOCATE( risfload(jpi,jpj), STAT=ialloc)247 ierr = ierr + ialloc 248 ! 249 ALLOCATE( mskisf_cav(jpi,jpj) , STAT=ialloc)239 ALLOCATE( fwfisf_par (jpi,jpj) , fwfisf_par_b(jpi,jpj) , & 240 & fwfisf_cav (jpi,jpj) , fwfisf_cav_b(jpi,jpj) , & 241 & fwfisf_oasis(jpi,jpj) , STAT=ialloc ) 242 ierr = ierr + ialloc 243 ! 244 ALLOCATE( risf_par_tsc(jpi,jpj,jpts) , risf_par_tsc_b(jpi,jpj,jpts) , STAT=ialloc ) 245 ierr = ierr + ialloc 246 ! 247 ALLOCATE( risf_cav_tsc(jpi,jpj,jpts) , risf_cav_tsc_b(jpi,jpj,jpts) , STAT=ialloc ) 248 ierr = ierr + ialloc 249 ! 250 ALLOCATE( risfload(jpi,jpj) , STAT=ialloc ) 251 ierr = ierr + ialloc 252 ! 253 ALLOCATE( mskisf_cav(jpi,jpj) , STAT=ialloc ) 250 254 ierr = ierr + ialloc 251 255 ! … … 254 258 ! 255 259 ! initalisation of fwf and tsc array to 0 256 risfload(:,:) = 0.0_wp 257 fwfisf_oasis(:,:) = 0.0_wp 258 fwfisf_par(:,:) = 0.0_wp ; fwfisf_par_b(:,:) = 0.0_wp 259 fwfisf_cav(:,:) = 0.0_wp ; fwfisf_cav_b(:,:) = 0.0_wp 260 risf_cav_tsc(:,:,:) = 0.0_wp ; risf_cav_tsc_b(:,:,:) = 0.0_wp 261 risf_par_tsc(:,:,:) = 0.0_wp ; risf_par_tsc_b(:,:,:) = 0.0_wp 262 ! 263 260 risfload (:,:) = 0._wp 261 fwfisf_oasis(:,:) = 0._wp 262 fwfisf_par (:,:) = 0._wp ; fwfisf_par_b (:,:) = 0._wp 263 fwfisf_cav (:,:) = 0._wp ; fwfisf_cav_b (:,:) = 0._wp 264 risf_cav_tsc(:,:,:) = 0._wp ; risf_cav_tsc_b(:,:,:) = 0._wp 265 risf_par_tsc(:,:,:) = 0._wp ; risf_par_tsc_b(:,:,:) = 0._wp 266 ! 264 267 END SUBROUTINE isf_alloc 265 268 269 !!====================================================================== 266 270 END MODULE isf_oce -
NEMO/trunk/src/OCE/ISF/isfload.F90
r13295 r14064 2 2 !!====================================================================== 3 3 !! *** MODULE isfload *** 4 !! isfload module :compute ice shelf load (needed for the hpg)4 !! Ice Shelves : compute ice shelf load (needed for the hpg) 5 5 !!====================================================================== 6 6 !! History : 4.1 ! 2019-09 (P. Mathiot) original code … … 8 8 9 9 !!---------------------------------------------------------------------- 10 !! isf load : compute ice shelf load10 !! isf_load : compute ice shelf load 11 11 !!---------------------------------------------------------------------- 12 12 … … 23 23 PRIVATE 24 24 25 PUBLIC isf_load 25 PUBLIC isf_load ! called by isfstp.F90 26 ! 26 27 !! * Substitutions 27 28 # include "do_loop_substitute.h90" 28 29 # include "domzgr_substitute.h90" 29 30 !!---------------------------------------------------------------------- 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 32 !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $ 33 !! Software governed by the CeCILL license (see ./LICENSE) 34 !!---------------------------------------------------------------------- 30 35 CONTAINS 31 36 … … 37 42 !! 38 43 !!-------------------------------------------------------------------- 39 !!-------------------------- OUT ------------------------------------- 40 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pisfload 41 !!-------------------------- IN ------------------------------------- 42 INTEGER, INTENT(in) :: Kmm ! ocean time level index 44 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 45 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pisfload ! ice shelf load 43 46 !!---------------------------------------------------------------------- 44 47 ! … … 46 49 ! the smaller the residual flow is, the better it is. 47 50 ! 48 ! ice shelf cavity51 ! type of ice shelf cavity 49 52 SELECT CASE ( cn_isfload ) 50 53 CASE ( 'uniform' ) … … 56 59 END SUBROUTINE isf_load 57 60 58 SUBROUTINE isf_load_uniform( Kmm, pisfload ) 61 62 SUBROUTINE isf_load_uniform( Kmm, pload ) 59 63 !!-------------------------------------------------------------------- 60 64 !! *** SUBROUTINE isf_load *** … … 67 71 !! 68 72 !!-------------------------------------------------------------------- 69 !!-------------------------- OUT ------------------------------------- 70 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pisfload 71 !!-------------------------- IN ------------------------------------- 72 INTEGER, INTENT(in) :: Kmm ! ocean time level index 73 !!-------------------------------------------------------------------- 73 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 74 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pload ! ice shelf load 75 ! 74 76 INTEGER :: ji, jj, jk 75 77 INTEGER :: ikt 76 REAL(wp) :: znad !77 78 REAL(wp), DIMENSION(jpi,jpj) :: zrhdtop_isf ! water density displaced by the ice shelf (at the interface) 78 79 REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts_top ! water properties displaced by the ice shelf 79 80 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrhd ! water density displaced by the ice shelf 80 81 !!---------------------------------------------------------------------- 81 !82 znad = 1._wp !- To use density and not density anomaly83 82 ! 84 83 ! !- assume water displaced by the ice shelf is at T=rn_isfload_T and S=rn_isfload_S (rude) … … 87 86 DO jk = 1, jpk !- compute density of the water displaced by the ice shelf 88 87 CALL eos( zts_top(:,:,:), gdept(:,:,jk,Kmm), zrhd(:,:,jk) ) 88 !!st ==>> CALL eos( zts_top(:,:,:), gdept_0(:,:,jk), zrhd(:,:,jk) ) 89 89 END DO 90 90 ! … … 93 93 ! 94 94 ! !- Surface value + ice shelf gradient 95 p isfload(:,:) = 0._wp! compute pressure due to ice shelf load95 pload(:,:) = 0._wp ! compute pressure due to ice shelf load 96 96 DO_2D( 1, 1, 1, 1 ) 97 97 ikt = mikt(ji,jj) 98 98 ! 99 99 IF ( ikt > 1 ) THEN 100 ! ! top layer of the ice shelf 101 pload(ji,jj) = pload(ji,jj) & 102 & + zrhd (ji,jj,1) * e3w(ji,jj,1,Kmm) 100 103 ! 101 ! top layer of the ice shelf 102 pisfload(ji,jj) = pisfload(ji,jj) + (znad + zrhd(ji,jj,1) ) & 103 & * e3w(ji,jj,1,Kmm) 104 ! 105 ! core layers of the ice shelf 106 DO jk = 2, ikt-1 107 pisfload(ji,jj) = pisfload(ji,jj) + (2._wp * znad + zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) & 108 & * e3w(ji,jj,jk,Kmm) 104 DO jk = 2, ikt-1 ! core layers of the ice shelf 105 pload(ji,jj) = pload(ji,jj) + (zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) & 106 & * e3w(ji,jj,jk,Kmm) 109 107 END DO 110 ! 111 ! deepest part of the ice shelf (between deepest T point and ice/ocean interface112 pisfload(ji,jj) = pisfload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1)) &113 & * ( risfdep(ji,jj) - gdept(ji,jj,ikt-1,Kmm) )108 ! ! deepest part of the ice shelf (between deepest T point and ice/ocean interface 109 pload(ji,jj) = pload(ji,jj) + ( zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1) ) & 110 & * ( risfdep(ji,jj) - gdept(ji,jj,ikt-1,Kmm) ) 111 !!st ==>> & * ( risfdep(ji,jj) - gdept_0(ji,jj,ikt-1) ) 114 112 ! 115 113 END IF … … 117 115 ! 118 116 END SUBROUTINE isf_load_uniform 119 117 118 !!====================================================================== 120 119 END MODULE isfload -
NEMO/trunk/src/OCE/ISF/isfstp.F90
r13237 r14064 2 2 !!====================================================================== 3 3 !! *** MODULE isfstp *** 4 !! Surface module: compute iceshelf load, melt and heat flux4 !! Ice Shelves : compute iceshelf load, melt and heat flux 5 5 !!====================================================================== 6 6 !! History : 3.2 ! 2011-02 (C.Harris ) Original code isf cav … … 42 42 !! Software governed by the CeCILL license (see ./LICENSE) 43 43 !!---------------------------------------------------------------------- 44 45 44 CONTAINS 46 45 47 SUBROUTINE isf_stp( kt, Kmm )46 SUBROUTINE isf_stp( kt, Kmm ) 48 47 !!--------------------------------------------------------------------- 49 48 !! *** ROUTINE isf_stp *** … … 58 57 !! - compute fluxes 59 58 !! - write restart variables 60 !! 61 !!---------------------------------------------------------------------- 62 INTEGER, INTENT(in) :: kt ! ocean time step 63 INTEGER, INTENT(in) :: Kmm ! ocean time level index 64 !!---------------------------------------------------------------------- 65 INTEGER :: jk ! loop index 66 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t ! e3t 59 !!---------------------------------------------------------------------- 60 INTEGER, INTENT(in) :: kt ! ocean time step 61 INTEGER, INTENT(in) :: Kmm ! ocean time level index 62 ! 63 INTEGER :: jk ! loop index 64 #if defined key_qco 65 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t ! 3D workspace 66 #endif 67 67 !!--------------------------------------------------------------------- 68 68 ! … … 83 83 ! 1.2: compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl) 84 84 rhisf_tbl_cav(:,:) = rn_htbl * mskisf_cav(:,:) 85 #if defined key_qco 85 86 DO jk = 1, jpk 86 87 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 87 88 END DO 88 CALL isf_tbl_lvl(ht(:,:), ze3t, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav) 89 CALL isf_tbl_lvl( ht(:,:), ze3t, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav ) 90 #else 91 CALL isf_tbl_lvl( ht(:,:), e3t, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav ) 92 #endif 89 93 ! 90 94 ! 1.3: compute ice shelf melt 91 CALL isf_cav( kt, Kmm, risf_cav_tsc, fwfisf_cav )95 CALL isf_cav( kt, Kmm, risf_cav_tsc, fwfisf_cav ) 92 96 ! 93 97 END IF … … 108 112 ! by simplicity, we assume the top level where param applied do not change with time (done in init part) 109 113 rhisf_tbl_par(:,:) = rhisf0_tbl_par(:,:) 114 #if defined key_qco 110 115 DO jk = 1, jpk 111 116 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 112 117 END DO 113 CALL isf_tbl_lvl(ht(:,:), ze3t, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par) 118 CALL isf_tbl_lvl( ht(:,:), ze3t, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 119 #else 120 CALL isf_tbl_lvl( ht(:,:), e3t, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 121 #endif 114 122 ! 115 123 ! 2.3: compute ice shelf melt 116 CALL isf_par( kt, Kmm, risf_par_tsc, fwfisf_par )124 CALL isf_par( kt, Kmm, risf_par_tsc, fwfisf_par ) 117 125 ! 118 126 END IF … … 128 136 END SUBROUTINE isf_stp 129 137 130 SUBROUTINE isf_init(Kbb, Kmm, Kaa) 138 139 SUBROUTINE isf_init( Kbb, Kmm, Kaa ) 131 140 !!--------------------------------------------------------------------- 132 141 !! *** ROUTINE isfstp_init *** … … 142 151 !! - call cav/param/isfcpl init routine 143 152 !!---------------------------------------------------------------------- 144 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 153 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 154 !!---------------------------------------------------------------------- 145 155 ! 146 156 ! constrain: l_isfoasis need to be known 147 157 ! 148 ! Read namelist 149 CALL isf_nam() 150 ! 151 ! Allocate public array 152 CALL isf_alloc() 153 ! 154 ! check option compatibility 155 CALL isf_ctl() 156 ! 157 ! compute ice shelf load 158 IF ( ln_isfcav ) CALL isf_load( Kmm, risfload ) 158 CALL isf_nam() ! Read namelist 159 ! 160 CALL isf_alloc() ! Allocate public array 161 ! 162 CALL isf_ctl() ! check option compatibility 163 ! 164 IF( ln_isfcav ) CALL isf_load( Kmm, risfload ) ! compute ice shelf load 159 165 ! 160 166 ! terminate routine now if no ice shelf melt formulation specify 161 IF ( ln_isf ) THEN 162 ! 163 !--------------------------------------------------------------------------------------------------------------------- 164 ! initialisation melt in the cavity 165 IF ( ln_isfcav_mlt ) CALL isf_cav_init() 166 ! 167 !--------------------------------------------------------------------------------------------------------------------- 168 ! initialisation parametrised melt 169 IF ( ln_isfpar_mlt ) CALL isf_par_init() 170 ! 171 !--------------------------------------------------------------------------------------------------------------------- 172 ! initialisation ice sheet coupling 173 IF( ln_isfcpl ) CALL isfcpl_init(Kbb, Kmm, Kaa) 167 IF( ln_isf ) THEN 168 ! 169 IF( ln_isfcav_mlt ) CALL isf_cav_init() ! initialisation melt in the cavity 170 ! 171 IF( ln_isfpar_mlt ) CALL isf_par_init() ! initialisation parametrised melt 172 ! 173 IF( ln_isfcpl ) CALL isfcpl_init( Kbb, Kmm, Kaa ) ! initialisation ice sheet coupling 174 174 ! 175 175 END IF … … 177 177 END SUBROUTINE isf_init 178 178 179 179 180 SUBROUTINE isf_ctl() 180 181 !!--------------------------------------------------------------------- … … 283 284 END IF 284 285 END SUBROUTINE isf_ctl 285 ! 286 287 286 288 SUBROUTINE isf_nam 287 289 !!---------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
