New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13151 for NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/src/OCE/FLO – NEMO

Ignore:
Timestamp:
2020-06-24T14:38:26+02:00 (4 years ago)
Author:
gm
Message:

result from merge with qco r12983

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  
    2626   REAL(wp), DIMENSION (3) ::   scoef1 = (/  0.5  ,  0.5  ,  1.0  /)           ! 
    2727 
     28#  include "domzgr_substitute.h90" 
    2829   !!---------------------------------------------------------------------- 
    2930   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
  • NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/src/OCE/FLO/floblk.F90

    r12489 r13151  
    2020   PUBLIC   flo_blk    ! routine called by floats.F90 
    2121 
     22#  include "domzgr_substitute.h90" 
     23 
    2224   !!---------------------------------------------------------------------- 
    2325   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    24    !! $Id$  
     26   !! $Id$ 
    2527   !! Software governed by the CeCILL license (see ./LICENSE) 
    2628   !!---------------------------------------------------------------------- 
     
    3032      !!--------------------------------------------------------------------- 
    3133      !!                  ***  ROUTINE flo_blk  *** 
    32       !!            
     34      !! 
    3335      !! ** Purpose :   Compute the geographical position,latitude, longitude 
    3436      !!      and depth of each float at each time step. 
    35       !!  
     37      !! 
    3638      !! ** Method  :   The position of a float is computed with Bruno Blanke 
    3739      !!      algorithm. We need to know the velocity field, the old positions 
     
    4749         zuoutfl,zvoutfl,zwoutfl,   &     ! transport across the ouput face 
    4850         zvol,                      &     ! volume of the mesh 
    49          zsurfz,                    &     ! surface of the face of the mesh  
     51         zsurfz,                    &     ! surface of the face of the mesh 
    5052         zind 
    5153 
     
    5355 
    5456      INTEGER  , DIMENSION ( jpnfl )  ::   iil, ijl, ikl                   ! index of nearest mesh 
    55       INTEGER  , DIMENSION ( jpnfl )  ::   iiloc , ijloc               
     57      INTEGER  , DIMENSION ( jpnfl )  ::   iiloc , ijloc 
    5658      INTEGER  , DIMENSION ( jpnfl )  ::   iiinfl, ijinfl, ikinfl          ! index of input mesh of the float. 
    5759      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 
    5961      !                                                                         ! velocity mesh. 
    6062      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 
    6466      !                                                                         ! 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 
    6668      !                                                                         ! of new position 
    6769      REAL(wp) , DIMENSION ( jpnfl )  ::   zufl, zvfl, zwfl                ! interpolated vel. at float position 
     
    7779 
    7880      ! Initialisation of parameters 
    79        
     81 
    8082      DO jfl = 1, jpnfl 
    8183         ! ages of floats are put at zero 
    8284         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. 
    8688         zgifl(jfl) = tpifl(jfl) - 0.5 
    8789         zgjfl(jfl) = tpjfl(jfl) - 0.5 
    8890         zgkfl(jfl) = MIN(-1.,-(tpkfl(jfl))) 
    89          ! surface drift every 10 days  
     91         ! surface drift every 10 days 
    9092         IF( ln_argo ) THEN 
    9193            IF( MOD(kt,150) >= 146 .OR. MOD(kt,150) == 0 )  zgkfl(jfl) = -1. 
     
    9698         ikl(jfl) =     INT(zgkfl(jfl)) 
    9799      END DO 
    98         
     100 
    99101      iloop = 0 
    100102222   DO jfl = 1, jpnfl 
     
    104106            iiloc(jfl) = iil(jfl) - mig(1) + 1 
    105107            ijloc(jfl) = ijl(jfl) - mjg(1) + 1 
    106 # else  
     108# else 
    107109            iiloc(jfl) = iil(jfl) 
    108110            ijloc(jfl) = ijl(jfl) 
    109111# 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) 
    117127 
    118128            ! for a isobar float zsurfz is put to zero. The vertical velocity will be zero too. 
     
    129139            zwoutfl=-(wb(iiloc(jfl),ijloc(jfl),- ikl(jfl)   )   & 
    130140               &   +  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 
    133143            zufl(jfl)=  zuinfl  + ( zgifl(jfl) - float(iil(jfl)-1) ) * ( zuoutfl - zuinfl) 
    134144            zvfl(jfl)=  zvinfl  + ( zgjfl(jfl) - float(ijl(jfl)-1) ) * ( zvoutfl - zvinfl) 
    135145            zwfl(jfl)=  zwinfl  + ( zgkfl(jfl) - float(ikl(jfl)-1) ) * ( zwoutfl - zwinfl) 
    136              
     146 
    137147            ! faces of input and output 
    138148            ! u-direction 
     
    147157               iiinfl (jfl) = iil(jfl) - 1 
    148158            ENDIF 
    149             ! v-direction        
     159            ! v-direction 
    150160            IF( zvfl(jfl) < 0. ) THEN 
    151161               ijoutfl(jfl) = ijl(jfl) - 1. 
     
    169179               ikinfl (jfl) = ikl(jfl) - 1. 
    170180            ENDIF 
    171              
     181 
    172182            ! compute the time to go out the mesh across a face 
    173183            ! u-direction 
     
    175185            zgidfl(jfl) = float(iioutfl(jfl) - iiinfl(jfl)) 
    176186            IF( zufl(jfl)*zuoutfl <= 0. ) THEN 
    177                ztxfl(jfl) = 1.E99 
     187               ztxfl(jfl) = HUGE(1._wp) 
    178188            ELSE 
    179189               IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN 
     
    191201            zgjdfl(jfl) = float(ijoutfl(jfl)-ijinfl(jfl)) 
    192202            IF( zvfl(jfl)*zvoutfl <= 0. ) THEN 
    193                ztyfl(jfl) = 1.E99 
     203               ztyfl(jfl) = HUGE(1._wp) 
    194204            ELSE 
    195205               IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN 
     
    203213               ENDIF 
    204214            ENDIF 
    205             ! w-direction         
    206             IF( nisobfl(jfl) == 1. ) THEN  
     215            ! w-direction 
     216            IF( nisobfl(jfl) == 1. ) THEN 
    207217               zwdfl (jfl) = zwoutfl - zwinfl 
    208218               zgkdfl(jfl) = float(ikoutfl(jfl) - ikinfl(jfl)) 
    209219               IF( zwfl(jfl)*zwoutfl <= 0. ) THEN 
    210                   ztzfl(jfl) = 1.E99 
     220                  ztzfl(jfl) = HUGE(1._wp) 
    211221               ELSE 
    212222                  IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN 
     
    221231               ENDIF 
    222232            ENDIF 
    223              
     233 
    224234            ! 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 
    227237               zttfl(jfl) = MIN(ztxfl(jfl),ztyfl(jfl),ztzfl(jfl)) 
    228238            ELSE 
     
    231241            ! new age of the FLOAT 
    232242            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 
    234244            ! time step 
    235245            IF( zagenewfl(jfl) > rn_Dt ) THEN 
     
    237247               zagenewfl(jfl) = rn_Dt 
    238248            ENDIF 
    239              
     249 
    240250            ! In the "minimal" direction we compute the index of new mesh 
    241251            ! on i-direction 
     
    250260               iiinfl(jfl) = ind 
    251261            ELSE 
    252                IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN  
     262               IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN 
    253263                  zgifl(jfl) = zgifl(jfl) + zgidfl(jfl)*zufl(jfl)    & 
    254264                     &       * ( EXP( zudfl(jfl)/zgidfl(jfl)*zttfl(jfl) ) - 1. ) /  zudfl(jfl) 
     
    268278               ijinfl(jfl) = ind 
    269279            ELSE 
    270                IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN  
     280               IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN 
    271281                  zgjfl(jfl) = zgjfl(jfl)+zgjdfl(jfl)*zvfl(jfl)   & 
    272282                     &       * ( EXP(zvdfl(jfl)/zgjdfl(jfl)*zttfl(jfl)) - 1. ) /  zvdfl(jfl) 
     
    287297                  ikinfl(jfl) = ind 
    288298               ELSE 
    289                   IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN  
     299                  IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN 
    290300                     zgkfl(jfl) = zgkfl(jfl)+zgkdfl(jfl)*zwfl(jfl)    & 
    291301                        &       * ( EXP(zwdfl(jfl)/zgkdfl(jfl)*zttfl(jfl)) - 1. ) /  zwdfl(jfl) 
     
    295305               ENDIF 
    296306            ENDIF 
    297              
     307 
    298308            ! coordinate of the new point on the temperature grid 
    299              
     309 
    300310            iil(jfl) = MAX(iiinfl(jfl),iioutfl(jfl)) 
    301311            ijl(jfl) = MAX(ijinfl(jfl),ijoutfl(jfl)) 
     
    306316!!Alexcadm     .    ikoutfl(jfl),ztxfl(jfl),ztyfl(jfl) 
    307317!!Alexcadm     .     ,ztzfl(jfl),zgifl(jfl), 
    308 !!Alexcadm     .  zgjfl(jfl)  
     318!!Alexcadm     .  zgjfl(jfl) 
    309319!!Alexcadm  IF (jfl == 910) write(*,*)'Flotteur 910', 
    310320!!Alexcadm     .    iiinfl(jfl),iioutfl(jfl),ijinfl(jfl) 
     
    312322!!Alexcadm     .    ikoutfl(jfl),ztxfl(jfl),ztyfl(jfl) 
    313323!!Alexcadm     .     ,ztzfl(jfl),zgifl(jfl), 
    314 !!Alexcadm     .  zgjfl(jfl)  
     324!!Alexcadm     .  zgjfl(jfl) 
    315325            ! reinitialisation of the age of FLOAT 
    316326            zagefl(jfl) = zagenewfl(jfl) 
     
    327337# endif 
    328338      END DO 
    329        
     339 
    330340      ! synchronisation 
    331341      CALL mpp_sum( 'floblk', zgifl , jpnfl )   ! sums over the global domain 
     
    335345      CALL mpp_sum( 'floblk', iil   , jpnfl ) 
    336346      CALL mpp_sum( 'floblk', ijl   , jpnfl ) 
    337        
     347 
    338348      ! Test to know if a  float hasn't integrated enought time 
    339349      IF( ln_argo ) THEN 
     
    361371!!Alexcadm     .       tpkfl(jpnfl),zufl(jpnfl),zvfl(jpnfl),zwfl(jpnfl) 
    362372      IF( ifin == 0 ) THEN 
    363          iloop = iloop + 1  
     373         iloop = iloop + 1 
    364374         GO TO 222 
    365375      ENDIF 
     
    369379 
    370380   !!====================================================================== 
    371 END MODULE floblk  
     381END MODULE floblk 
Note: See TracChangeset for help on using the changeset viewer.