Changeset 12088 for NEMO/branches/UKMO/NEMO_4.0.1_GO8_package/src
- Timestamp:
- 2019-12-06T14:13:14+01:00 (4 years ago)
- Location:
- NEMO/branches/UKMO/NEMO_4.0.1_GO8_package/src
- Files:
-
- 10 edited
-
ICE/icedyn_adv_pra.F90 (modified) (13 diffs)
-
ICE/icedyn_rdgrft.F90 (modified) (11 diffs)
-
ICE/iceitd.F90 (modified) (4 diffs)
-
ICE/icevar.F90 (modified) (1 diff)
-
OCE/BDY/bdydta.F90 (modified) (4 diffs)
-
OCE/DYN/dynspg_ts.F90 (modified) (2 diffs)
-
OCE/FLO/flodom.F90 (modified) (1 diff)
-
OCE/FLO/flowri.F90 (modified) (1 diff)
-
OCE/TRA/traadv_fct.F90 (modified) (1 diff)
-
TOP/trcbdy.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.1_GO8_package/src/ICE/icedyn_adv_pra.F90
r11715 r12088 16 16 !! adv_pra_rst : read/write Prather field in ice restart file, or initialized to zero 17 17 !!---------------------------------------------------------------------- 18 USE phycst ! physical constant 18 19 USE dom_oce ! ocean domain 19 20 USE ice ! sea-ice variables … … 39 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxsal, sysal, sxxsal, syysal, sxysal ! ice salinity 40 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxage, syage, sxxage, syyage, sxyage ! ice age 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxopw, syopw, sxxopw, syyopw, sxyopw ! open water in sea ice42 42 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sxc0 , syc0 , sxxc0 , syyc0 , sxyc0 ! snow layers heat content 43 43 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sxe , sye , sxxe , syye , sxye ! ice layers heat content … … 81 81 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i ! ice heat content 82 82 ! 83 INTEGER :: j k, jl, jt! dummy loop indices83 INTEGER :: ji,jj, jk, jl, jt ! dummy loop indices 84 84 INTEGER :: icycle ! number of sub-timestep for the advection 85 85 REAL(wp) :: zdt ! - - 86 86 REAL(wp), DIMENSION(1) :: zcflprv, zcflnow ! for global communication 87 REAL(wp), DIMENSION(jpi,jpj) :: zati1, zati2 88 REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx 87 89 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zarea 88 REAL(wp), DIMENSION(jpi,jpj,1) :: z0opw89 90 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z0ice, z0snw, z0ai, z0smi, z0oi 90 91 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z0ap , z0vp … … 109 110 zdt = rdt_ice / REAL(icycle) 110 111 111 !------------------------- 112 ! transported fields 113 !------------------------- 114 z0opw(:,:,1) = pato_i(:,:) * e1e2t(:,:) ! Open water area 115 DO jl = 1, jpl 116 zarea(:,:,jl) = e1e2t(:,:) 117 z0snw(:,:,jl) = pv_s (:,:,jl) * e1e2t(:,:) ! Snow volume 118 z0ice(:,:,jl) = pv_i (:,:,jl) * e1e2t(:,:) ! Ice volume 119 z0ai (:,:,jl) = pa_i (:,:,jl) * e1e2t(:,:) ! Ice area 120 z0smi(:,:,jl) = psv_i(:,:,jl) * e1e2t(:,:) ! Salt content 121 z0oi (:,:,jl) = poa_i(:,:,jl) * e1e2t(:,:) ! Age content 122 DO jk = 1, nlay_s 123 z0es(:,:,jk,jl) = pe_s(:,:,jk,jl) * e1e2t(:,:) ! Snow heat content 124 END DO 125 DO jk = 1, nlay_i 126 z0ei(:,:,jk,jl) = pe_i(:,:,jk,jl) * e1e2t(:,:) ! Ice heat content 127 END DO 128 IF ( ln_pnd_H12 ) THEN 129 z0ap(:,:,jl) = pa_ip(:,:,jl) * e1e2t(:,:) ! Melt pond fraction 130 z0vp(:,:,jl) = pv_ip(:,:,jl) * e1e2t(:,:) ! Melt pond volume 131 ENDIF 132 END DO 133 134 ! !--------------------------------------------! 135 IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN !== odd ice time step: adv_x then adv_y ==! 136 ! !--------------------------------------------! 137 DO jt = 1, icycle 138 CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0opw , sxopw , sxxopw , syopw , syyopw , sxyopw ) !--- open water 139 CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0opw , sxopw , sxxopw , syopw , syyopw , sxyopw ) 140 CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume 141 CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) 142 CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) !--- snow volume 143 CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) 144 CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity 145 CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) 146 CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) !--- ice concentration 147 CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) 148 CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) !--- ice age 149 CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) 112 ! --- transport --- ! 113 zudy(:,:) = pu_ice(:,:) * e2u(:,:) 114 zvdx(:,:) = pv_ice(:,:) * e1v(:,:) 115 116 DO jt = 1, icycle 117 118 ! record at_i before advection (for open water) 119 zati1(:,:) = SUM( pa_i(:,:,:), dim=3 ) 120 121 ! --- transported fields --- ! 122 DO jl = 1, jpl 123 zarea(:,:,jl) = e1e2t(:,:) 124 z0snw(:,:,jl) = pv_s (:,:,jl) * e1e2t(:,:) ! Snow volume 125 z0ice(:,:,jl) = pv_i (:,:,jl) * e1e2t(:,:) ! Ice volume 126 z0ai (:,:,jl) = pa_i (:,:,jl) * e1e2t(:,:) ! Ice area 127 z0smi(:,:,jl) = psv_i(:,:,jl) * e1e2t(:,:) ! Salt content 128 z0oi (:,:,jl) = poa_i(:,:,jl) * e1e2t(:,:) ! Age content 129 DO jk = 1, nlay_s 130 z0es(:,:,jk,jl) = pe_s(:,:,jk,jl) * e1e2t(:,:) ! Snow heat content 131 END DO 132 DO jk = 1, nlay_i 133 z0ei(:,:,jk,jl) = pe_i(:,:,jk,jl) * e1e2t(:,:) ! Ice heat content 134 END DO 135 IF ( ln_pnd_H12 ) THEN 136 z0ap(:,:,jl) = pa_ip(:,:,jl) * e1e2t(:,:) ! Melt pond fraction 137 z0vp(:,:,jl) = pv_ip(:,:,jl) * e1e2t(:,:) ! Melt pond volume 138 ENDIF 139 END DO 140 ! 141 ! !--------------------------------------------! 142 IF( MOD( (kt - 1) / nn_fsbc , 2 ) == MOD( (jt - 1) , 2 ) ) THEN !== odd ice time step: adv_x then adv_y ==! 143 ! !--------------------------------------------! 144 CALL adv_x( zdt , zudy , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume 145 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) 146 CALL adv_x( zdt , zudy , 1._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) !--- snow volume 147 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) 148 CALL adv_x( zdt , zudy , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity 149 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) 150 CALL adv_x( zdt , zudy , 1._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) !--- ice concentration 151 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) 152 CALL adv_x( zdt , zudy , 1._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) !--- ice age 153 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) 150 154 ! 151 DO jk = 1, nlay_s 152 CALL adv_x( zdt, pu_ice, 1._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:), &153 & 154 CALL adv_y( zdt, pv_ice, 0._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:), &155 & 156 END DO 157 DO jk = 1, nlay_i 158 CALL adv_x( zdt, pu_ice, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), &159 & 160 CALL adv_y( zdt, pv_ice, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), &161 & 155 DO jk = 1, nlay_s !--- snow heat content 156 CALL adv_x( zdt, zudy, 1._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:), & 157 & sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) 158 CALL adv_y( zdt, zvdx, 0._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:), & 159 & sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) 160 END DO 161 DO jk = 1, nlay_i !--- ice heat content 162 CALL adv_x( zdt, zudy, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 163 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 164 CALL adv_y( zdt, zvdx, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 165 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 162 166 END DO 163 167 ! 164 168 IF ( ln_pnd_H12 ) THEN 165 CALL adv_x( zdt , pu_ice, 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction166 CALL adv_y( zdt , pv_ice, 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )167 CALL adv_x( zdt , pu_ice, 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume168 CALL adv_y( zdt , pv_ice, 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )169 CALL adv_x( zdt , zudy , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction 170 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 171 CALL adv_x( zdt , zudy , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume 172 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 169 173 ENDIF 170 END DO 171 ! !--------------------------------------------! 172 ELSE !== even ice time step: adv_y then adv_x ==! 173 ! !--------------------------------------------! 174 DO jt = 1, icycle 175 CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0opw , sxopw , sxxopw , syopw , syyopw , sxyopw ) !--- open water 176 CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0opw , sxopw , sxxopw , syopw , syyopw , sxyopw ) 177 CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume 178 CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) 179 CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) !--- snow volume 180 CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) 181 CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity 182 CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) 183 CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) !--- ice concentration 184 CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) 185 CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) !--- ice age 186 CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) 187 DO jk = 1, nlay_s !--- snow heat content 188 CALL adv_y( zdt, pv_ice, 1._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:), & 189 & sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) 190 CALL adv_x( zdt, pu_ice, 0._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:), & 191 & sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) 192 END DO 193 DO jk = 1, nlay_i !--- ice heat content 194 CALL adv_y( zdt, pv_ice, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 195 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 196 CALL adv_x( zdt, pu_ice, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 197 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 174 ! !--------------------------------------------! 175 ELSE !== even ice time step: adv_y then adv_x ==! 176 ! !--------------------------------------------! 177 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume 178 CALL adv_x( zdt , zudy , 0._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) 179 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) !--- snow volume 180 CALL adv_x( zdt , zudy , 0._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) 181 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity 182 CALL adv_x( zdt , zudy , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) 183 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) !--- ice concentration 184 CALL adv_x( zdt , zudy , 0._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) 185 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) !--- ice age 186 CALL adv_x( zdt , zudy , 0._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) 187 DO jk = 1, nlay_s !--- snow heat content 188 CALL adv_y( zdt, zvdx, 1._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:), & 189 & sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) 190 CALL adv_x( zdt, zudy, 0._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:), & 191 & sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) 192 END DO 193 DO jk = 1, nlay_i !--- ice heat content 194 CALL adv_y( zdt, zvdx, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 195 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 196 CALL adv_x( zdt, zudy, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 197 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 198 198 END DO 199 199 IF ( ln_pnd_H12 ) THEN 200 CALL adv_y( zdt , pv_ice, 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction201 CALL adv_x( zdt , pu_ice, 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )202 CALL adv_y( zdt , pv_ice, 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume203 CALL adv_x( zdt , pu_ice, 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )200 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction 201 CALL adv_x( zdt , zudy , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 202 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume 203 CALL adv_x( zdt , zudy , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 204 204 ENDIF 205 END DO 206 ENDIF 207 208 !------------------------------------------- 209 ! Recover the properties from their contents 210 !------------------------------------------- 211 pato_i(:,:) = z0opw(:,:,1) * r1_e1e2t(:,:) * tmask(:,:,1) 212 DO jl = 1, jpl 213 pv_i (:,:,jl) = z0ice(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 214 pv_s (:,:,jl) = z0snw(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 215 psv_i(:,:,jl) = z0smi(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 216 poa_i(:,:,jl) = z0oi (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 217 pa_i (:,:,jl) = z0ai (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 218 DO jk = 1, nlay_s 219 pe_s(:,:,jk,jl) = z0es(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 220 END DO 221 DO jk = 1, nlay_i 222 pe_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 223 END DO 224 IF ( ln_pnd_H12 ) THEN 225 pa_ip(:,:,jl) = z0ap(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 226 pv_ip(:,:,jl) = z0vp(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 205 ! 227 206 ENDIF 207 208 ! --- Recover the properties from their contents --- ! 209 DO jl = 1, jpl 210 pv_i (:,:,jl) = z0ice(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 211 pv_s (:,:,jl) = z0snw(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 212 psv_i(:,:,jl) = z0smi(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 213 poa_i(:,:,jl) = z0oi (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 214 pa_i (:,:,jl) = z0ai (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 215 DO jk = 1, nlay_s 216 pe_s(:,:,jk,jl) = z0es(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 217 END DO 218 DO jk = 1, nlay_i 219 pe_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 220 END DO 221 IF ( ln_pnd_H12 ) THEN 222 pa_ip(:,:,jl) = z0ap(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 223 pv_ip(:,:,jl) = z0vp(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 224 ENDIF 225 END DO 226 ! 227 ! derive open water from ice concentration 228 zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 229 DO jj = 2, jpjm1 230 DO ji = fs_2, fs_jpim1 231 pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & !--- open water 232 & - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 233 END DO 234 END DO 235 CALL lbc_lnk( 'icedyn_adv_pra', pato_i, 'T', 1. ) 236 ! 237 ! --- Ensure non-negative fields --- ! 238 ! Remove negative values (conservation is ensured) 239 ! (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) 240 CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 241 ! 242 ! --- Ensure snow load is not too big --- ! 243 CALL Hsnow( zdt, pv_i, pv_s, pa_i, pa_ip, pe_s ) 244 ! 228 245 END DO 229 !230 ! --- Ensure non-negative fields --- !231 ! Remove negative values (conservation is ensured)232 ! (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20)233 CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i )234 !235 ! --- Ensure snow load is not too big --- !236 CALL Hsnow( zdt, pv_i, pv_s, pa_i, pa_ip, pe_s )237 246 ! 238 247 IF( lrst_ice ) CALL adv_pra_rst( 'WRITE', kt ) !* write Prather fields in the restart file … … 296 305 DO ji = 1, jpi 297 306 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 298 zalf = MAX( 0._wp, put(ji,jj) ) * pdt * e2u(ji,jj)/ psm(ji,jj,jl)307 zalf = MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl) 299 308 zalfq = zalf * zalf 300 309 zalf1 = 1.0 - zalf … … 322 331 DO jj = 2, jpjm1 ! Flux from i+1 to i when u LT 0. 323 332 DO ji = 1, fs_jpim1 324 zalf = MAX( 0._wp, -put(ji,jj) ) * pdt * e2u(ji,jj)/ psm(ji+1,jj,jl)333 zalf = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl) 325 334 zalg (ji,jj) = zalf 326 335 zalfq = zalf * zalf … … 465 474 DO ji = fs_2, fs_jpim1 466 475 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 467 zalf = MAX( 0._wp, pvt(ji,jj) ) * pdt * e1v(ji,jj)/ psm(ji,jj,jl)476 zalf = MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl) 468 477 zalfq = zalf * zalf 469 478 zalf1 = 1.0 - zalf … … 491 500 DO jj = 1, jpjm1 ! Flux from j+1 to j when v LT 0. 492 501 DO ji = fs_2, fs_jpim1 493 zalf = ( MAX(0._wp, -pvt(ji,jj) ) * pdt * e1v(ji,jj) )/ psm(ji,jj+1,jl)502 zalf = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl) 494 503 zalg (ji,jj) = zalf 495 504 zalfq = zalf * zalf … … 645 654 ! 646 655 ! !* allocate prather fields 647 ALLOCATE( sxopw(jpi,jpj,1) , syopw(jpi,jpj,1) , sxxopw(jpi,jpj,1) , syyopw(jpi,jpj,1) , sxyopw(jpi,jpj,1) , & 648 & sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) , & 656 ALLOCATE( sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) , & 649 657 & sxsn (jpi,jpj,jpl) , sysn (jpi,jpj,jpl) , sxxsn (jpi,jpj,jpl) , syysn (jpi,jpj,jpl) , sxysn (jpi,jpj,jpl) , & 650 658 & sxa (jpi,jpj,jpl) , sya (jpi,jpj,jpl) , sxxa (jpi,jpj,jpl) , syya (jpi,jpj,jpl) , sxya (jpi,jpj,jpl) , & … … 692 700 ! !==========================! 693 701 ! 694 IF( ln_rstart ) THEN ; id1 = iom_varid( numrir, 'sx opw' , ldstop = .FALSE. ) ! file exist: id1>0702 IF( ln_rstart ) THEN ; id1 = iom_varid( numrir, 'sxice' , ldstop = .FALSE. ) ! file exist: id1>0 695 703 ELSE ; id1 = 0 ! no restart: id1=0 696 704 ENDIF … … 728 736 CALL iom_get( numrir, jpdom_autoglo, 'syyage', syyage ) 729 737 CALL iom_get( numrir, jpdom_autoglo, 'sxyage', sxyage ) 730 ! ! open water in sea ice731 CALL iom_get( numrir, jpdom_autoglo, 'sxopw' , sxopw )732 CALL iom_get( numrir, jpdom_autoglo, 'syopw' , syopw )733 CALL iom_get( numrir, jpdom_autoglo, 'sxxopw', sxxopw )734 CALL iom_get( numrir, jpdom_autoglo, 'syyopw', syyopw )735 CALL iom_get( numrir, jpdom_autoglo, 'sxyopw', sxyopw )736 738 ! ! snow layers heat content 737 739 DO jk = 1, nlay_s … … 776 778 sxsal = 0._wp ; sysal = 0._wp ; sxxsal = 0._wp ; syysal = 0._wp ; sxysal = 0._wp ! ice salinity 777 779 sxage = 0._wp ; syage = 0._wp ; sxxage = 0._wp ; syyage = 0._wp ; sxyage = 0._wp ! ice age 778 sxopw = 0._wp ; syopw = 0._wp ; sxxopw = 0._wp ; syyopw = 0._wp ; sxyopw = 0._wp ! open water in sea ice779 780 sxc0 = 0._wp ; syc0 = 0._wp ; sxxc0 = 0._wp ; syyc0 = 0._wp ; sxyc0 = 0._wp ! snow layers heat content 780 781 sxe = 0._wp ; sye = 0._wp ; sxxe = 0._wp ; syye = 0._wp ; sxye = 0._wp ! ice layers heat content … … 825 826 CALL iom_rstput( iter, nitrst, numriw, 'syyage', syyage ) 826 827 CALL iom_rstput( iter, nitrst, numriw, 'sxyage', sxyage ) 827 ! ! open water in sea ice828 CALL iom_rstput( iter, nitrst, numriw, 'sxopw' , sxopw )829 CALL iom_rstput( iter, nitrst, numriw, 'syopw' , syopw )830 CALL iom_rstput( iter, nitrst, numriw, 'sxxopw', sxxopw )831 CALL iom_rstput( iter, nitrst, numriw, 'syyopw', syyopw )832 CALL iom_rstput( iter, nitrst, numriw, 'sxyopw', sxyopw )833 828 ! ! snow layers heat content 834 829 DO jk = 1, nlay_s -
NEMO/branches/UKMO/NEMO_4.0.1_GO8_package/src/ICE/icedyn_rdgrft.F90
r11715 r12088 86 86 !! *** ROUTINE ice_dyn_rdgrft_alloc *** 87 87 !!------------------------------------------------------------------- 88 ALLOCATE( closing_net(jpij) , opning(jpij) , closing_gross(jpij),&89 & apartf(jpij,0:jpl) , hrmin(jpij,jpl), hraft(jpij,jpl) , aridge(jpij,jpl),&90 & hrmax (jpij,jpl), hi_hrdg(jpij,jpl) , araft (jpij,jpl),&88 ALLOCATE( closing_net(jpij) , opning(jpij) , closing_gross(jpij) , & 89 & apartf(jpij,0:jpl) , hrmin (jpij,jpl) , hraft(jpij,jpl) , aridge(jpij,jpl), & 90 & hrmax (jpij,jpl) , hi_hrdg(jpij,jpl) , araft(jpij,jpl) , & 91 91 & ze_i_2d(jpij,nlay_i,jpl), ze_s_2d(jpij,nlay_s,jpl), STAT=ice_dyn_rdgrft_alloc ) 92 92 … … 137 137 REAL(wp) :: zfac ! local scalar 138 138 INTEGER , DIMENSION(jpij) :: iptidx ! compute ridge/raft or not 139 REAL(wp), DIMENSION(jpij) :: zdivu_adv ! divu as implied by transport scheme (1/s)140 139 REAL(wp), DIMENSION(jpij) :: zdivu, zdelt ! 1D divu_i & delta_i 141 140 ! … … 175 174 176 175 ! just needed here 177 CALL tab_2d_1d( npti, nptidx(1:npti), zdivu (1:npti) , divu_i )178 176 CALL tab_2d_1d( npti, nptidx(1:npti), zdelt (1:npti) , delta_i ) 179 177 ! needed here and in the iteration loop 178 CALL tab_2d_1d( npti, nptidx(1:npti), zdivu (1:npti) , divu_i) ! zdivu is used as a work array here (no change in divu_i) 180 179 CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,1:jpl), a_i ) 181 180 CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,1:jpl), v_i ) … … 187 186 closing_net(ji) = rn_csrdg * 0.5_wp * ( zdelt(ji) - ABS( zdivu(ji) ) ) - MIN( zdivu(ji), 0._wp ) 188 187 ! 189 ! divergence given by the advection scheme 190 ! (which may not be equal to divu as computed from the velocity field) 191 IF ( ln_adv_Pra ) THEN 192 zdivu_adv(ji) = ( 1._wp - ato_i_1d(ji) - SUM( a_i_2d(ji,:) ) ) * r1_rdtice 193 ELSEIF( ln_adv_UMx ) THEN 194 zdivu_adv(ji) = zdivu(ji) 195 ENDIF 196 ! 197 IF( zdivu_adv(ji) < 0._wp ) closing_net(ji) = MAX( closing_net(ji), -zdivu_adv(ji) ) ! make sure the closing rate is large enough 198 ! ! to give asum = 1.0 after ridging 188 IF( zdivu(ji) < 0._wp ) closing_net(ji) = MAX( closing_net(ji), -zdivu(ji) ) ! make sure the closing rate is large enough 189 ! ! to give asum = 1.0 after ridging 199 190 ! Opening rate (non-negative) that will give asum = 1.0 after ridging. 200 opning(ji) = closing_net(ji) + zdivu _adv(ji)191 opning(ji) = closing_net(ji) + zdivu(ji) 201 192 END DO 202 193 ! … … 215 206 ato_i_1d (ipti) = ato_i_1d (ji) 216 207 closing_net(ipti) = closing_net(ji) 217 zdivu _adv (ipti) = zdivu_adv(ji)208 zdivu (ipti) = zdivu (ji) 218 209 opning (ipti) = opning (ji) 219 210 ENDIF … … 259 250 ELSE 260 251 iterate_ridging = 1 261 zdivu _adv(ji) = zfac * r1_rdtice262 closing_net(ji) = MAX( 0._wp, -zdivu _adv(ji) )263 opning (ji) = MAX( 0._wp, zdivu _adv(ji) )252 zdivu (ji) = zfac * r1_rdtice 253 closing_net(ji) = MAX( 0._wp, -zdivu(ji) ) 254 opning (ji) = MAX( 0._wp, zdivu(ji) ) 264 255 ENDIF 265 256 END DO … … 309 300 310 301 ! ! Ice thickness needed for rafting 311 WHERE( pa_i(1:npti,:) > epsi 20 ) ; zhi(1:npti,:) = pv_i(1:npti,:) / pa_i(1:npti,:)302 WHERE( pa_i(1:npti,:) > epsi10 ) ; zhi(1:npti,:) = pv_i(1:npti,:) / pa_i(1:npti,:) 312 303 ELSEWHERE ; zhi(1:npti,:) = 0._wp 313 304 END WHERE … … 328 319 zasum(1:npti) = pato_i(1:npti) + SUM( pa_i(1:npti,:), dim=2 ) 329 320 ! 330 WHERE( zasum(1:npti) > epsi 20 ) ; z1_asum(1:npti) = 1._wp / zasum(1:npti)321 WHERE( zasum(1:npti) > epsi10 ) ; z1_asum(1:npti) = 1._wp / zasum(1:npti) 331 322 ELSEWHERE ; z1_asum(1:npti) = 0._wp 332 323 END WHERE … … 454 445 ! Based on the ITD of ridging and ridged ice, convert the net closing rate to a gross closing rate. 455 446 ! NOTE: 0 < aksum <= 1 456 WHERE( zaksum(1:npti) > epsi 20 ) ; closing_gross(1:npti) = pclosing_net(1:npti) / zaksum(1:npti)447 WHERE( zaksum(1:npti) > epsi10 ) ; closing_gross(1:npti) = pclosing_net(1:npti) / zaksum(1:npti) 457 448 ELSEWHERE ; closing_gross(1:npti) = 0._wp 458 449 END WHERE … … 537 528 IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp ) THEN ! only if ice is ridging 538 529 539 IF( a_i_2d(ji,jl1) > epsi 20 ) THEN ; z1_ai(ji) = 1._wp / a_i_2d(ji,jl1)530 IF( a_i_2d(ji,jl1) > epsi10 ) THEN ; z1_ai(ji) = 1._wp / a_i_2d(ji,jl1) 540 531 ELSE ; z1_ai(ji) = 0._wp 541 532 ENDIF … … 595 586 ! virtual salt flux to keep salinity constant 596 587 IF( nn_icesal /= 2 ) THEN 597 sirdg2(ji) = sirdg2(ji) - vsw * ( sss_1d(ji) - s_i_1d(ji) ) 588 sirdg2(ji) = sirdg2(ji) - vsw * ( sss_1d(ji) - s_i_1d(ji) ) ! ridge salinity = s_i 598 589 sfx_bri_1d(ji) = sfx_bri_1d(ji) + sss_1d(ji) * vsw * rhoi * r1_rdtice & ! put back sss_m into the ocean 599 590 & - s_i_1d(ji) * vsw * rhoi * r1_rdtice ! and get s_i from the ocean -
NEMO/branches/UKMO/NEMO_4.0.1_GO8_package/src/ICE/iceitd.F90
r11715 r12088 211 211 CALL itd_glinear( zhb0(1:npti) , zhb1(1:npti) , h_ib_1d(1:npti) , a_i_1d(1:npti) , & ! in 212 212 & g0 (1:npti,1), g1 (1:npti,1), hL (1:npti,1), hR (1:npti,1) ) ! out 213 213 ! 214 214 ! Area lost due to melting of thin ice 215 215 DO ji = 1, npti … … 218 218 ! 219 219 zdh0 = h_i_1d(ji) - h_ib_1d(ji) 220 IF( zdh0 < 0.0 ) THEN ! remove area from category 1220 IF( zdh0 < 0.0 ) THEN ! remove area from category 1 221 221 zdh0 = MIN( -zdh0, hi_max(1) ) 222 222 !Integrate g(1) from 0 to dh0 to estimate area melted … … 226 226 zx1 = zetamax 227 227 zx2 = 0.5 * zetamax * zetamax 228 zda0 = g1(ji,1) * zx2 + g0(ji,1) * zx1 228 zda0 = g1(ji,1) * zx2 + g0(ji,1) * zx1 ! ice area removed 229 229 zdamax = a_i_1d(ji) * (1.0 - h_i_1d(ji) / h_ib_1d(ji) ) ! Constrain new thickness <= h_i 230 zda0 = MIN( zda0, zdamax ) ! ice area lost due to melting 231 ! of thin ice (zdamax > 0) 230 zda0 = MIN( zda0, zdamax ) ! ice area lost due to melting of thin ice (zdamax > 0) 232 231 ! Remove area, conserving volume 233 232 h_i_1d(ji) = h_i_1d(ji) * a_i_1d(ji) / ( a_i_1d(ji) - zda0 ) … … 349 348 DO ji = 1, npti 350 349 ! 351 IF( paice(ji) > epsi10 .AND. phice(ji) > 0._wp) THEN350 IF( paice(ji) > epsi10 .AND. phice(ji) > epsi10 ) THEN 352 351 ! 353 352 ! Initialize hL and hR -
NEMO/branches/UKMO/NEMO_4.0.1_GO8_package/src/ICE/icevar.F90
r11715 r12088 622 622 pv_s (ji,jj,jl) = 0._wp 623 623 ENDIF 624 IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN624 IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN 625 625 sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * z1_dt 626 626 psv_i (ji,jj,jl) = 0._wp -
NEMO/branches/UKMO/NEMO_4.0.1_GO8_package/src/OCE/BDY/bdydta.F90
r11715 r12088 171 171 ii = idx_bdy(jbdy)%nbi(ib,igrd) 172 172 ij = idx_bdy(jbdy)%nbj(ib,igrd) 173 dta_bdy(jbdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_ bdytem) * tmask(ii,ij,ik)174 dta_bdy(jbdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_ bdysal) * tmask(ii,ij,ik)173 dta_bdy(jbdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik) 174 dta_bdy(jbdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik) 175 175 END DO 176 176 END DO … … 447 447 ELSE ; ipl = 1 ! xy or xyt 448 448 ENDIF 449 bf(jp_bdya_i,jbdy)%clrootname = 'NOT USED' ! reset to default value as this subdomain may not need to read this bdy 449 450 ENDIF 450 451 ENDIF … … 615 616 ENDIF 616 617 617 IF( llneed ) THEN! dta_bdy(jbdy)%xxx will be needed618 IF( llneed .AND. iszdim > 0 ) THEN ! dta_bdy(jbdy)%xxx will be needed 618 619 ! ! -> must be associated with an allocated target 619 620 ALLOCATE( bf_alias(1)%fnow( iszdim, 1, ipk ) ) ! allocate the target … … 624 625 bf_alias(1)%imap => idx_bdy(jbdy)%nbmap(1:iszdim,igrd) ! associate the mapping used for this bdy 625 626 bf_alias(1)%igrd = igrd ! used only for vertical integration of 3D arrays 627 bf_alias(1)%ibdy = jbdy ! " " " " " " " " 626 628 bf_alias(1)%ltotvel = ln_full_vel ! T if u3d is full velocity 627 629 bf_alias(1)%lzint = ln_zinterp ! T if it requires a vertical interpolation -
NEMO/branches/UKMO/NEMO_4.0.1_GO8_package/src/OCE/DYN/dynspg_ts.F90
r11715 r12088 687 687 hvr_e(2:jpim1,2:jpjm1) = ssvmask(2:jpim1,2:jpjm1) / ( hv_e(2:jpim1,2:jpjm1) + 1._wp - ssvmask(2:jpim1,2:jpjm1) ) 688 688 CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp & 689 & , hu_e , 'U', -1._wp, hv_e , 'V', -1._wp &690 & , hur_e, 'U', -1._wp, hvr_e, 'V', -1._wp )689 & , hu_e , 'U', 1._wp, hv_e , 'V', 1._wp & 690 & , hur_e, 'U', 1._wp, hvr_e, 'V', 1._wp ) 691 691 ELSE 692 692 CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp ) … … 803 803 804 804 IF ( ln_wd_dl .and. ln_wd_dl_bc) THEN 805 ! need to set lbc here because not done prior time averaging 806 CALL lbc_lnk_multi( 'dynspg_ts', zuwdav2, 'U', 1._wp, zvwdav2, 'V', 1._wp) 805 807 DO jk = 1, jpkm1 806 808 un(:,:,jk) = ( un_adv(:,:)*r1_hu_n(:,:) & -
NEMO/branches/UKMO/NEMO_4.0.1_GO8_package/src/OCE/FLO/flodom.F90
r11715 r12088 433 433 IF( ABS(dlx) > 1.0_wp ) dlx = 1.0_wp 434 434 ! 435 dld = ATAN( DSQRT( 1._wp * ( 1._wp-dlx )/( 1._wp+dlx ) )) * 222.24_wp / dls435 dld = ATAN(SQRT( 1._wp * ( 1._wp-dlx )/( 1._wp+dlx ) )) * 222.24_wp / dls 436 436 flo_dstnce = dld * 1000._wp 437 437 ! -
NEMO/branches/UKMO/NEMO_4.0.1_GO8_package/src/OCE/FLO/flowri.F90
r11715 r12088 221 221 clname=TRIM(clname)//".nc" 222 222 223 CALL fliocrfd( clname , (/ 'ntraj' , 't' /), (/ jpnfl , -1/) , numflo )223 CALL fliocrfd( clname , (/'ntraj' , ' t' /), (/ jpnfl , -1/) , numflo ) 224 224 225 225 CALL fliodefv( numflo, 'traj_lon' , (/1,2/), v_t=flio_r8, long_name="Longitude" , units="degrees_east" ) -
NEMO/branches/UKMO/NEMO_4.0.1_GO8_package/src/OCE/TRA/traadv_fct.F90
r11715 r12088 659 659 DO ji = fs_2, fs_jpim1 660 660 ikt = mikt(ji,jj) + 1 ! w-point below the 1st wet point 661 ikb = mbkt(ji,jj)! - above the last wet point661 ikb = MAX(mbkt(ji,jj), 2) ! - above the last wet point 662 662 ! 663 663 zwd (ji,jj,ikt) = 1._wp ! top -
NEMO/branches/UKMO/NEMO_4.0.1_GO8_package/src/TOP/trcbdy.F90
r11715 r12088 95 95 END DO 96 96 IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN ! if need to send/recv in at least one direction 97 CALL lbc_lnk( ' bdytra', tsa, 'T', 1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )97 CALL lbc_lnk( 'trcbdy', tra, 'T', 1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 98 98 END IF 99 99 !
Note: See TracChangeset
for help on using the changeset viewer.
