- Timestamp:
- 2020-03-23T22:16:19+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/FLO/floblk.F90
r12377 r12590 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) = e2u(iiloc(jfl)-1,ijloc(jfl) ) & 116 & * e3u(iiloc(jfl)-1,ijloc(jfl) ,-ikl(jfl),Kmm) 117 zsurfx(2) = e2u(iiloc(jfl) ,ijloc(jfl) ) & 118 & * e3u(iiloc(jfl) ,ijloc(jfl) ,-ikl(jfl),Kmm) 119 zsurfy(1) = e1v(iiloc(jfl) ,ijloc(jfl)-1) & 120 & * e3v(iiloc(jfl) ,ijloc(jfl)-1,-ikl(jfl),Kmm) 121 zsurfy(2) = e1v(iiloc(jfl) ,ijloc(jfl) ) & 122 & * e3v(iiloc(jfl) ,ijloc(jfl) ,-ikl(jfl),Kmm) 117 123 118 124 ! for a isobar float zsurfz is put to zero. The vertical velocity will be zero too. … … 129 135 zwoutfl=-(wb(iiloc(jfl),ijloc(jfl),- ikl(jfl) ) & 130 136 & + ww(iiloc(jfl),ijloc(jfl),- ikl(jfl) ) )/2. * zsurfz*nisobfl(jfl) 131 132 ! interpolation of velocity field on the float initial position 137 138 ! interpolation of velocity field on the float initial position 133 139 zufl(jfl)= zuinfl + ( zgifl(jfl) - float(iil(jfl)-1) ) * ( zuoutfl - zuinfl) 134 140 zvfl(jfl)= zvinfl + ( zgjfl(jfl) - float(ijl(jfl)-1) ) * ( zvoutfl - zvinfl) 135 141 zwfl(jfl)= zwinfl + ( zgkfl(jfl) - float(ikl(jfl)-1) ) * ( zwoutfl - zwinfl) 136 142 137 143 ! faces of input and output 138 144 ! u-direction … … 147 153 iiinfl (jfl) = iil(jfl) - 1 148 154 ENDIF 149 ! v-direction 155 ! v-direction 150 156 IF( zvfl(jfl) < 0. ) THEN 151 157 ijoutfl(jfl) = ijl(jfl) - 1. … … 169 175 ikinfl (jfl) = ikl(jfl) - 1. 170 176 ENDIF 171 177 172 178 ! compute the time to go out the mesh across a face 173 179 ! u-direction … … 203 209 ENDIF 204 210 ENDIF 205 ! w-direction 206 IF( nisobfl(jfl) == 1. ) THEN 211 ! w-direction 212 IF( nisobfl(jfl) == 1. ) THEN 207 213 zwdfl (jfl) = zwoutfl - zwinfl 208 214 zgkdfl(jfl) = float(ikoutfl(jfl) - ikinfl(jfl)) … … 221 227 ENDIF 222 228 ENDIF 223 229 224 230 ! the time to go leave the mesh is the smallest time 225 226 IF( nisobfl(jfl) == 1. ) THEN 231 232 IF( nisobfl(jfl) == 1. ) THEN 227 233 zttfl(jfl) = MIN(ztxfl(jfl),ztyfl(jfl),ztzfl(jfl)) 228 234 ELSE … … 231 237 ! new age of the FLOAT 232 238 zagenewfl(jfl) = zagefl(jfl) + zttfl(jfl)*zvol 233 ! test to know if the "age" of the float is not bigger than the 239 ! test to know if the "age" of the float is not bigger than the 234 240 ! time step 235 241 IF( zagenewfl(jfl) > rdt ) THEN … … 237 243 zagenewfl(jfl) = rdt 238 244 ENDIF 239 245 240 246 ! In the "minimal" direction we compute the index of new mesh 241 247 ! on i-direction … … 250 256 iiinfl(jfl) = ind 251 257 ELSE 252 IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN 258 IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN 253 259 zgifl(jfl) = zgifl(jfl) + zgidfl(jfl)*zufl(jfl) & 254 260 & * ( EXP( zudfl(jfl)/zgidfl(jfl)*zttfl(jfl) ) - 1. ) / zudfl(jfl) … … 268 274 ijinfl(jfl) = ind 269 275 ELSE 270 IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN 276 IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN 271 277 zgjfl(jfl) = zgjfl(jfl)+zgjdfl(jfl)*zvfl(jfl) & 272 278 & * ( EXP(zvdfl(jfl)/zgjdfl(jfl)*zttfl(jfl)) - 1. ) / zvdfl(jfl) … … 287 293 ikinfl(jfl) = ind 288 294 ELSE 289 IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN 295 IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN 290 296 zgkfl(jfl) = zgkfl(jfl)+zgkdfl(jfl)*zwfl(jfl) & 291 297 & * ( EXP(zwdfl(jfl)/zgkdfl(jfl)*zttfl(jfl)) - 1. ) / zwdfl(jfl) … … 295 301 ENDIF 296 302 ENDIF 297 303 298 304 ! coordinate of the new point on the temperature grid 299 305 300 306 iil(jfl) = MAX(iiinfl(jfl),iioutfl(jfl)) 301 307 ijl(jfl) = MAX(ijinfl(jfl),ijoutfl(jfl)) … … 306 312 !!Alexcadm . ikoutfl(jfl),ztxfl(jfl),ztyfl(jfl) 307 313 !!Alexcadm . ,ztzfl(jfl),zgifl(jfl), 308 !!Alexcadm . zgjfl(jfl) 314 !!Alexcadm . zgjfl(jfl) 309 315 !!Alexcadm IF (jfl == 910) write(*,*)'Flotteur 910', 310 316 !!Alexcadm . iiinfl(jfl),iioutfl(jfl),ijinfl(jfl) … … 312 318 !!Alexcadm . ikoutfl(jfl),ztxfl(jfl),ztyfl(jfl) 313 319 !!Alexcadm . ,ztzfl(jfl),zgifl(jfl), 314 !!Alexcadm . zgjfl(jfl) 320 !!Alexcadm . zgjfl(jfl) 315 321 ! reinitialisation of the age of FLOAT 316 322 zagefl(jfl) = zagenewfl(jfl) … … 327 333 # endif 328 334 END DO 329 335 330 336 ! synchronisation 331 337 CALL mpp_sum( 'floblk', zgifl , jpnfl ) ! sums over the global domain … … 335 341 CALL mpp_sum( 'floblk', iil , jpnfl ) 336 342 CALL mpp_sum( 'floblk', ijl , jpnfl ) 337 343 338 344 ! Test to know if a float hasn't integrated enought time 339 345 IF( ln_argo ) THEN … … 361 367 !!Alexcadm . tpkfl(jpnfl),zufl(jpnfl),zvfl(jpnfl),zwfl(jpnfl) 362 368 IF( ifin == 0 ) THEN 363 iloop = iloop + 1 369 iloop = iloop + 1 364 370 GO TO 222 365 371 ENDIF … … 369 375 370 376 !!====================================================================== 371 END MODULE floblk 377 END MODULE floblk
Note: See TracChangeset
for help on using the changeset viewer.
