- Timestamp:
- 2020-06-24T14:38:26+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/src/OCE/FLO
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/src/OCE/FLO/flo4rk.F90
r12489 r13151 26 26 REAL(wp), DIMENSION (3) :: scoef1 = (/ 0.5 , 0.5 , 1.0 /) ! 27 27 28 # include "domzgr_substitute.h90" 28 29 !!---------------------------------------------------------------------- 29 30 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/src/OCE/FLO/floblk.F90
r12489 r13151 20 20 PUBLIC flo_blk ! routine called by floats.F90 21 21 22 # include "domzgr_substitute.h90" 23 22 24 !!---------------------------------------------------------------------- 23 25 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 24 !! $Id$ 26 !! $Id$ 25 27 !! Software governed by the CeCILL license (see ./LICENSE) 26 28 !!---------------------------------------------------------------------- … … 30 32 !!--------------------------------------------------------------------- 31 33 !! *** ROUTINE flo_blk *** 32 !! 34 !! 33 35 !! ** Purpose : Compute the geographical position,latitude, longitude 34 36 !! and depth of each float at each time step. 35 !! 37 !! 36 38 !! ** Method : The position of a float is computed with Bruno Blanke 37 39 !! algorithm. We need to know the velocity field, the old positions … … 47 49 zuoutfl,zvoutfl,zwoutfl, & ! transport across the ouput face 48 50 zvol, & ! volume of the mesh 49 zsurfz, & ! surface of the face of the mesh 51 zsurfz, & ! surface of the face of the mesh 50 52 zind 51 53 … … 53 55 54 56 INTEGER , DIMENSION ( jpnfl ) :: iil, ijl, ikl ! index of nearest mesh 55 INTEGER , DIMENSION ( jpnfl ) :: iiloc , ijloc 57 INTEGER , DIMENSION ( jpnfl ) :: iiloc , ijloc 56 58 INTEGER , DIMENSION ( jpnfl ) :: iiinfl, ijinfl, ikinfl ! index of input mesh of the float. 57 59 INTEGER , DIMENSION ( jpnfl ) :: iioutfl, ijoutfl, ikoutfl ! index of output mesh of the float. 58 REAL(wp) , DIMENSION ( jpnfl ) :: zgifl, zgjfl, zgkfl ! position of floats, index on 60 REAL(wp) , DIMENSION ( jpnfl ) :: zgifl, zgjfl, zgkfl ! position of floats, index on 59 61 ! ! velocity mesh. 60 62 REAL(wp) , DIMENSION ( jpnfl ) :: ztxfl, ztyfl, ztzfl ! time for a float to quit the mesh 61 ! ! across one of the face x,y and z 62 REAL(wp) , DIMENSION ( jpnfl ) :: zttfl ! time for a float to quit the mesh 63 REAL(wp) , DIMENSION ( jpnfl ) :: zagefl ! time during which, trajectorie of 63 ! ! across one of the face x,y and z 64 REAL(wp) , DIMENSION ( jpnfl ) :: zttfl ! time for a float to quit the mesh 65 REAL(wp) , DIMENSION ( jpnfl ) :: zagefl ! time during which, trajectorie of 64 66 ! ! the float has been computed 65 REAL(wp) , DIMENSION ( jpnfl ) :: zagenewfl ! new age of float after calculation 67 REAL(wp) , DIMENSION ( jpnfl ) :: zagenewfl ! new age of float after calculation 66 68 ! ! of new position 67 69 REAL(wp) , DIMENSION ( jpnfl ) :: zufl, zvfl, zwfl ! interpolated vel. at float position … … 77 79 78 80 ! Initialisation of parameters 79 81 80 82 DO jfl = 1, jpnfl 81 83 ! ages of floats are put at zero 82 84 zagefl(jfl) = 0. 83 ! index on the velocity grid 84 ! We considere k coordinate negative, with this transformation 85 ! the computation in the 3 direction is the same. 85 ! index on the velocity grid 86 ! We considere k coordinate negative, with this transformation 87 ! the computation in the 3 direction is the same. 86 88 zgifl(jfl) = tpifl(jfl) - 0.5 87 89 zgjfl(jfl) = tpjfl(jfl) - 0.5 88 90 zgkfl(jfl) = MIN(-1.,-(tpkfl(jfl))) 89 ! surface drift every 10 days 91 ! surface drift every 10 days 90 92 IF( ln_argo ) THEN 91 93 IF( MOD(kt,150) >= 146 .OR. MOD(kt,150) == 0 ) zgkfl(jfl) = -1. … … 96 98 ikl(jfl) = INT(zgkfl(jfl)) 97 99 END DO 98 100 99 101 iloop = 0 100 102 222 DO jfl = 1, jpnfl … … 104 106 iiloc(jfl) = iil(jfl) - mig(1) + 1 105 107 ijloc(jfl) = ijl(jfl) - mjg(1) + 1 106 # else 108 # else 107 109 iiloc(jfl) = iil(jfl) 108 110 ijloc(jfl) = ijl(jfl) 109 111 # endif 110 111 ! compute the transport across the mesh where the float is. 112 !!bug (gm) change e3t into e3. but never checked 113 zsurfx(1) = e2u(iiloc(jfl)-1,ijloc(jfl) ) * e3u(iiloc(jfl)-1,ijloc(jfl) ,-ikl(jfl),Kmm) 114 zsurfx(2) = e2u(iiloc(jfl) ,ijloc(jfl) ) * e3u(iiloc(jfl) ,ijloc(jfl) ,-ikl(jfl),Kmm) 115 zsurfy(1) = e1v(iiloc(jfl) ,ijloc(jfl)-1) * e3v(iiloc(jfl) ,ijloc(jfl)-1,-ikl(jfl),Kmm) 116 zsurfy(2) = e1v(iiloc(jfl) ,ijloc(jfl) ) * e3v(iiloc(jfl) ,ijloc(jfl) ,-ikl(jfl),Kmm) 112 113 ! compute the transport across the mesh where the float is. 114 !!bug (gm) change e3t into e3. but never checked 115 zsurfx(1) = & 116 & e2u(iiloc(jfl)-1,ijloc(jfl) ) & 117 & * e3u(iiloc(jfl)-1,ijloc(jfl) ,-ikl(jfl),Kmm) 118 zsurfx(2) = & 119 & e2u(iiloc(jfl) ,ijloc(jfl) ) & 120 & * e3u(iiloc(jfl) ,ijloc(jfl) ,-ikl(jfl),Kmm) 121 zsurfy(1) = & 122 & e1v(iiloc(jfl) ,ijloc(jfl)-1) & 123 & * e3v(iiloc(jfl) ,ijloc(jfl)-1,-ikl(jfl),Kmm) 124 zsurfy(2) = & 125 & e1v(iiloc(jfl) ,ijloc(jfl) ) & 126 & * e3v(iiloc(jfl) ,ijloc(jfl) ,-ikl(jfl),Kmm) 117 127 118 128 ! for a isobar float zsurfz is put to zero. The vertical velocity will be zero too. … … 129 139 zwoutfl=-(wb(iiloc(jfl),ijloc(jfl),- ikl(jfl) ) & 130 140 & + ww(iiloc(jfl),ijloc(jfl),- ikl(jfl) ) )/2. * zsurfz*nisobfl(jfl) 131 132 ! interpolation of velocity field on the float initial position 141 142 ! interpolation of velocity field on the float initial position 133 143 zufl(jfl)= zuinfl + ( zgifl(jfl) - float(iil(jfl)-1) ) * ( zuoutfl - zuinfl) 134 144 zvfl(jfl)= zvinfl + ( zgjfl(jfl) - float(ijl(jfl)-1) ) * ( zvoutfl - zvinfl) 135 145 zwfl(jfl)= zwinfl + ( zgkfl(jfl) - float(ikl(jfl)-1) ) * ( zwoutfl - zwinfl) 136 146 137 147 ! faces of input and output 138 148 ! u-direction … … 147 157 iiinfl (jfl) = iil(jfl) - 1 148 158 ENDIF 149 ! v-direction 159 ! v-direction 150 160 IF( zvfl(jfl) < 0. ) THEN 151 161 ijoutfl(jfl) = ijl(jfl) - 1. … … 169 179 ikinfl (jfl) = ikl(jfl) - 1. 170 180 ENDIF 171 181 172 182 ! compute the time to go out the mesh across a face 173 183 ! u-direction … … 175 185 zgidfl(jfl) = float(iioutfl(jfl) - iiinfl(jfl)) 176 186 IF( zufl(jfl)*zuoutfl <= 0. ) THEN 177 ztxfl(jfl) = 1.E99187 ztxfl(jfl) = HUGE(1._wp) 178 188 ELSE 179 189 IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN … … 191 201 zgjdfl(jfl) = float(ijoutfl(jfl)-ijinfl(jfl)) 192 202 IF( zvfl(jfl)*zvoutfl <= 0. ) THEN 193 ztyfl(jfl) = 1.E99203 ztyfl(jfl) = HUGE(1._wp) 194 204 ELSE 195 205 IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN … … 203 213 ENDIF 204 214 ENDIF 205 ! w-direction 206 IF( nisobfl(jfl) == 1. ) THEN 215 ! w-direction 216 IF( nisobfl(jfl) == 1. ) THEN 207 217 zwdfl (jfl) = zwoutfl - zwinfl 208 218 zgkdfl(jfl) = float(ikoutfl(jfl) - ikinfl(jfl)) 209 219 IF( zwfl(jfl)*zwoutfl <= 0. ) THEN 210 ztzfl(jfl) = 1.E99220 ztzfl(jfl) = HUGE(1._wp) 211 221 ELSE 212 222 IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN … … 221 231 ENDIF 222 232 ENDIF 223 233 224 234 ! the time to go leave the mesh is the smallest time 225 226 IF( nisobfl(jfl) == 1. ) THEN 235 236 IF( nisobfl(jfl) == 1. ) THEN 227 237 zttfl(jfl) = MIN(ztxfl(jfl),ztyfl(jfl),ztzfl(jfl)) 228 238 ELSE … … 231 241 ! new age of the FLOAT 232 242 zagenewfl(jfl) = zagefl(jfl) + zttfl(jfl)*zvol 233 ! test to know if the "age" of the float is not bigger than the 243 ! test to know if the "age" of the float is not bigger than the 234 244 ! time step 235 245 IF( zagenewfl(jfl) > rn_Dt ) THEN … … 237 247 zagenewfl(jfl) = rn_Dt 238 248 ENDIF 239 249 240 250 ! In the "minimal" direction we compute the index of new mesh 241 251 ! on i-direction … … 250 260 iiinfl(jfl) = ind 251 261 ELSE 252 IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN 262 IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN 253 263 zgifl(jfl) = zgifl(jfl) + zgidfl(jfl)*zufl(jfl) & 254 264 & * ( EXP( zudfl(jfl)/zgidfl(jfl)*zttfl(jfl) ) - 1. ) / zudfl(jfl) … … 268 278 ijinfl(jfl) = ind 269 279 ELSE 270 IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN 280 IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN 271 281 zgjfl(jfl) = zgjfl(jfl)+zgjdfl(jfl)*zvfl(jfl) & 272 282 & * ( EXP(zvdfl(jfl)/zgjdfl(jfl)*zttfl(jfl)) - 1. ) / zvdfl(jfl) … … 287 297 ikinfl(jfl) = ind 288 298 ELSE 289 IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN 299 IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN 290 300 zgkfl(jfl) = zgkfl(jfl)+zgkdfl(jfl)*zwfl(jfl) & 291 301 & * ( EXP(zwdfl(jfl)/zgkdfl(jfl)*zttfl(jfl)) - 1. ) / zwdfl(jfl) … … 295 305 ENDIF 296 306 ENDIF 297 307 298 308 ! coordinate of the new point on the temperature grid 299 309 300 310 iil(jfl) = MAX(iiinfl(jfl),iioutfl(jfl)) 301 311 ijl(jfl) = MAX(ijinfl(jfl),ijoutfl(jfl)) … … 306 316 !!Alexcadm . ikoutfl(jfl),ztxfl(jfl),ztyfl(jfl) 307 317 !!Alexcadm . ,ztzfl(jfl),zgifl(jfl), 308 !!Alexcadm . zgjfl(jfl) 318 !!Alexcadm . zgjfl(jfl) 309 319 !!Alexcadm IF (jfl == 910) write(*,*)'Flotteur 910', 310 320 !!Alexcadm . iiinfl(jfl),iioutfl(jfl),ijinfl(jfl) … … 312 322 !!Alexcadm . ikoutfl(jfl),ztxfl(jfl),ztyfl(jfl) 313 323 !!Alexcadm . ,ztzfl(jfl),zgifl(jfl), 314 !!Alexcadm . zgjfl(jfl) 324 !!Alexcadm . zgjfl(jfl) 315 325 ! reinitialisation of the age of FLOAT 316 326 zagefl(jfl) = zagenewfl(jfl) … … 327 337 # endif 328 338 END DO 329 339 330 340 ! synchronisation 331 341 CALL mpp_sum( 'floblk', zgifl , jpnfl ) ! sums over the global domain … … 335 345 CALL mpp_sum( 'floblk', iil , jpnfl ) 336 346 CALL mpp_sum( 'floblk', ijl , jpnfl ) 337 347 338 348 ! Test to know if a float hasn't integrated enought time 339 349 IF( ln_argo ) THEN … … 361 371 !!Alexcadm . tpkfl(jpnfl),zufl(jpnfl),zvfl(jpnfl),zwfl(jpnfl) 362 372 IF( ifin == 0 ) THEN 363 iloop = iloop + 1 373 iloop = iloop + 1 364 374 GO TO 222 365 375 ENDIF … … 369 379 370 380 !!====================================================================== 371 END MODULE floblk 381 END MODULE floblk
Note: See TracChangeset
for help on using the changeset viewer.