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 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/FLO – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/FLO/flo4rk.F90

    r10068 r13463  
    44   !! Ocean floats :   trajectory computation using a 4th order Runge-Kutta 
    55   !!====================================================================== 
    6 #if   defined key_floats 
    7    !!---------------------------------------------------------------------- 
    8    !!   'key_floats'                                     float trajectories 
     6   !! 
    97   !!---------------------------------------------------------------------- 
    108   !!   flo_4rk        : Compute the geographical position of floats 
    … …  
    2826   REAL(wp), DIMENSION (3) ::   scoef1 = (/  0.5  ,  0.5  ,  1.0  /)           ! 
    2927 
     28#  include "domzgr_substitute.h90" 
    3029   !!---------------------------------------------------------------------- 
    3130   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    3534CONTAINS 
    3635 
    37    SUBROUTINE flo_4rk( kt ) 
     36   SUBROUTINE flo_4rk( kt, Kbb, Kmm ) 
    3837      !!---------------------------------------------------------------------- 
    3938      !!                  ***  ROUTINE flo_4rk  *** 
    … …  
    4746      !!       floats and the grid defined on the domain. 
    4847      !!---------------------------------------------------------------------- 
    49       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     48      INTEGER, INTENT(in) ::   kt         ! ocean time-step index 
     49      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
    5050      !! 
    5151      INTEGER ::  jfl, jind           ! dummy loop indices 
    … …  
    127127       
    128128         ! for each step we compute the compute the velocity with Lagrange interpolation 
    129          CALL flo_interp( zgifl, zgjfl, zgkfl, zufl, zvfl, zwfl, jind ) 
     129         CALL flo_interp( Kbb, Kmm, zgifl, zgjfl, zgkfl, zufl, zvfl, zwfl, jind ) 
    130130          
    131131         ! computation of Runge-Kutta factor 
    132132         DO jfl = 1, jpnfl 
    133             zrkxfl(jfl,jind) = rdt*zufl(jfl) 
    134             zrkyfl(jfl,jind) = rdt*zvfl(jfl) 
    135             zrkzfl(jfl,jind) = rdt*zwfl(jfl) 
     133            zrkxfl(jfl,jind) = rn_Dt*zufl(jfl) 
     134            zrkyfl(jfl,jind) = rn_Dt*zvfl(jfl) 
     135            zrkzfl(jfl,jind) = rn_Dt*zwfl(jfl) 
    136136         END DO 
    137137         IF( jind /= 4 ) THEN 
    … …  
    155155 
    156156 
    157    SUBROUTINE flo_interp( pxt , pyt , pzt ,      & 
     157   SUBROUTINE flo_interp( Kbb, Kmm,              & 
     158      &                   pxt , pyt , pzt ,      & 
    158159      &                   pufl, pvfl, pwfl, ki ) 
    159160      !!---------------------------------------------------------------------- 
    … …  
    167168      !!      integrated with RK method. 
    168169      !!---------------------------------------------------------------------- 
     170      INTEGER                    , INTENT(in   ) ::   Kbb, Kmm           ! ocean time level indices 
    169171      REAL(wp) , DIMENSION(jpnfl), INTENT(in   ) ::   pxt , pyt , pzt    ! position of the float 
    170172      REAL(wp) , DIMENSION(jpnfl), INTENT(  out) ::   pufl, pvfl, pwfl   ! velocity at this position 
    … …  
    248250               DO jind3 = 1, 4 
    249251                  ztufl(jfl,jind1,jind2,jind3) =   & 
    250                      &   (  tcoef1(ki) * ub(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3)) +   & 
    251                      &      tcoef2(ki) * un(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3)) )   & 
     252                     &   (  tcoef1(ki) * uu(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3),Kbb) +   & 
     253                     &      tcoef2(ki) * uu(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3),Kmm) )   & 
    252254                     &      / e1u(iidu(jfl,jind1),ijdu(jfl,jind2))  
    253255               END DO 
    … …  
    332334               DO jind3 = 1 ,4 
    333335                  ztvfl(jfl,jind1,jind2,jind3)=   & 
    334                      &   ( tcoef1(ki) * vb(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3))  +   & 
    335                      &     tcoef2(ki) * vn(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3)) )    &  
     336                     &   ( tcoef1(ki) * vv(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3),Kbb)  +   & 
     337                     &     tcoef2(ki) * vv(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3),Kmm) )    &  
    336338                     &     / e2v(iidv(jfl,jind1),ijdv(jfl,jind2)) 
    337339               END DO 
    … …  
    424426                  ztwfl(jfl,jind1,jind2,jind3)=   & 
    425427                     &   ( tcoef1(ki) * wb(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3))+   & 
    426                      &     tcoef2(ki) * wn(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3)) )  & 
    427                      &   / e3w_n(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3)) 
     428                     &     tcoef2(ki) * ww(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3)) )  & 
     429                     &   / e3w(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3),Kmm) 
    428430               END DO 
    429431            END DO 
    … …  
    445447   END SUBROUTINE flo_interp 
    446448 
    447 #  else 
    448    !!---------------------------------------------------------------------- 
    449    !!   No floats                                              Dummy module 
    450    !!---------------------------------------------------------------------- 
    451 #endif 
    452     
    453449   !!====================================================================== 
    454450END MODULE flo4rk 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/FLO/flo_oce.F90

    r10425 r13463  
    66   !! History :   OPA  ! 1999-10  (CLIPPER projet) 
    77   !!   NEMO      1.0  ! 2002-11  (G. Madec, A. Bozec)  F90: Free form and module 
    8    !!---------------------------------------------------------------------- 
    9 #if   defined   key_floats 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_floats'                                        drifting floats 
    128   !!---------------------------------------------------------------------- 
    139   USE par_oce         ! ocean parameters 
    … …  
    2016   PUBLIC   flo_oce_alloc   ! Routine called in floats.F90 
    2117 
    22    LOGICAL, PUBLIC, PARAMETER ::   lk_floats = .TRUE.    !: float flag 
    23  
    2418   !! float parameters 
    2519   !! ---------------- 
     20   LOGICAL, PUBLIC ::   ln_floats   !: Activate floats or not 
    2621   INTEGER, PUBLIC ::   jpnfl       !: total number of floats during the run 
    2722   INTEGER, PUBLIC ::   jpnnewflo   !: number of floats added in a new run 
    … …  
    6863   END FUNCTION flo_oce_alloc 
    6964 
    70 #else 
    71    !!---------------------------------------------------------------------- 
    72    !!   Default option :                                 NO drifting floats 
    73    !!---------------------------------------------------------------------- 
    74    LOGICAL, PUBLIC, PARAMETER ::   lk_floats = .FALSE.   !: float flag 
    75 #endif 
    76  
    7765   !!====================================================================== 
    7866END MODULE flo_oce 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/FLO/floats.F90

    r10068 r13463  
    77   !!   NEMO     1.0  ! 2002-06  (A. Bozec)  F90, Free form and module 
    88   !!---------------------------------------------------------------------- 
    9 #if   defined   key_floats 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_floats'                                     float trajectories 
     9   !! 
    1210   !!---------------------------------------------------------------------- 
    1311   !!   flo_stp   : float trajectories computation 
    … …  
    3028 
    3129   PUBLIC   flo_stp    ! routine called by step.F90 
    32    PUBLIC   flo_init   ! routine called by opa.F90 
     30   PUBLIC   flo_init   ! routine called by nemogcm.F90 
    3331 
    3432   !!---------------------------------------------------------------------- 
    … …  
    3937CONTAINS 
    4038 
    41    SUBROUTINE flo_stp( kt ) 
     39   SUBROUTINE flo_stp( kt, Kbb, Kmm ) 
    4240      !!---------------------------------------------------------------------- 
    4341      !!                   ***  ROUTINE flo_stp  *** 
    … …  
    5048      !!        if ln_flork4 =T 
    5149      !!---------------------------------------------------------------------- 
    52       INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
     50      INTEGER, INTENT( in  ) ::   kt        ! ocean time step 
     51      INTEGER, INTENT( in  ) ::   Kbb, Kmm  ! ocean time level indices  
    5352      !!---------------------------------------------------------------------- 
    5453      ! 
    5554      IF( ln_timing )   CALL timing_start('flo_stp') 
    5655      ! 
    57       IF( ln_flork4 ) THEN   ;   CALL flo_4rk( kt )        ! Trajectories using a 4th order Runge Kutta scheme 
    58       ELSE                   ;   CALL flo_blk( kt )        ! Trajectories using Blanke' algorithme 
     56      IF( ln_flork4 ) THEN   ;   CALL flo_4rk( kt, Kbb, Kmm )  ! Trajectories using a 4th order Runge Kutta scheme 
     57      ELSE                   ;   CALL flo_blk( kt, Kbb, Kmm )  ! Trajectories using Blanke' algorithme 
    5958      ENDIF 
    6059      ! 
    6160      IF( lk_mpp )   CALL mppsync   ! synchronization of all the processor 
    6261      ! 
    63       CALL flo_wri( kt )      ! trajectories ouput  
     62      CALL flo_wri( kt, Kmm ) ! trajectories ouput  
    6463      ! 
    6564      CALL flo_rst( kt )      ! trajectories restart 
    6665      ! 
    67       wb(:,:,:) = wn(:,:,:)         ! Save the old vertical velocity field 
     66      wb(:,:,:) = ww(:,:,:)         ! Save the old vertical velocity field 
    6867      ! 
    6968      IF( ln_timing )   CALL timing_stop('flo_stp') 
    … …  
    7271 
    7372 
    74    SUBROUTINE flo_init 
     73   SUBROUTINE flo_init( Kmm ) 
    7574      !!---------------------------------------------------------------- 
    7675      !!                 ***  ROUTINE flo_init  *** 
    … …  
    7877      !! ** Purpose :   Read the namelist of floats 
    7978      !!---------------------------------------------------------------------- 
     79      INTEGER, INTENT(in) :: Kmm       ! ocean time level index 
     80      ! 
    8081      INTEGER ::   jfl 
    8182      INTEGER ::   ios                 ! Local integer output status for namelist read 
    8283      ! 
    83       NAMELIST/namflo/ jpnfl, jpnnewflo, ln_rstflo, nn_writefl, nn_stockfl, ln_argo, ln_flork4, ln_ariane, ln_flo_ascii 
     84      NAMELIST/namflo/ ln_floats, jpnfl, jpnnewflo, ln_rstflo, nn_writefl, nn_stockfl, ln_argo, ln_flork4, ln_ariane, ln_flo_ascii 
    8485      !!--------------------------------------------------------------------- 
    8586      ! 
    … …  
    8889      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    8990 
    90       REWIND( numnam_ref )              ! Namelist namflo in reference namelist : Floats 
    9191      READ  ( numnam_ref, namflo, IOSTAT = ios, ERR = 901) 
    92 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namflo in reference namelist', lwp ) 
     92901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namflo in reference namelist' ) 
    9393 
    94       REWIND( numnam_cfg )              ! Namelist namflo in configuration namelist : Floats 
    9594      READ  ( numnam_cfg, namflo, IOSTAT = ios, ERR = 902 ) 
    96 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namflo in configuration namelist', lwp ) 
     95902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namflo in configuration namelist' ) 
    9796      IF(lwm) WRITE ( numond, namflo ) 
    9897      ! 
    … …  
    10099         WRITE(numout,*) 
    101100         WRITE(numout,*) '         Namelist floats :' 
    102          WRITE(numout,*) '            number of floats                      jpnfl        = ', jpnfl 
    103          WRITE(numout,*) '            number of new floats                  jpnflnewflo  = ', jpnnewflo 
    104          WRITE(numout,*) '            restart                               ln_rstflo    = ', ln_rstflo 
    105          WRITE(numout,*) '            frequency of float output file        nn_writefl   = ', nn_writefl 
    106          WRITE(numout,*) '            frequency of float restart file       nn_stockfl   = ', nn_stockfl 
    107          WRITE(numout,*) '            Argo type floats                      ln_argo      = ', ln_argo 
    108          WRITE(numout,*) '            Computation of T trajectories         ln_flork4    = ', ln_flork4 
    109          WRITE(numout,*) '            Use of ariane convention              ln_ariane    = ', ln_ariane 
    110          WRITE(numout,*) '            ascii output (T) or netcdf output (F) ln_flo_ascii = ', ln_flo_ascii 
     101         WRITE(numout,*) '            Activate floats or not                   ln_floats    = ', ln_floats 
     102         WRITE(numout,*) '               number of floats                      jpnfl        = ', jpnfl 
     103         WRITE(numout,*) '               number of new floats                  jpnflnewflo  = ', jpnnewflo 
     104         WRITE(numout,*) '               restart                               ln_rstflo    = ', ln_rstflo 
     105         WRITE(numout,*) '               frequency of float output file        nn_writefl   = ', nn_writefl 
     106         WRITE(numout,*) '               frequency of float restart file       nn_stockfl   = ', nn_stockfl 
     107         WRITE(numout,*) '               Argo type floats                      ln_argo      = ', ln_argo 
     108         WRITE(numout,*) '               Computation of T trajectories         ln_flork4    = ', ln_flork4 
     109         WRITE(numout,*) '               Use of ariane convention              ln_ariane    = ', ln_ariane 
     110         WRITE(numout,*) '               ascii output (T) or netcdf output (F) ln_flo_ascii = ', ln_flo_ascii 
    111111 
    112112      ENDIF 
    113113      ! 
    114       !                             ! allocate floats arrays 
    115       IF( flo_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'flo_init : unable to allocate arrays' ) 
    116       ! 
    117       !                             ! allocate flodom arrays 
    118       IF( flo_dom_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'flo_dom : unable to allocate arrays' ) 
    119       ! 
    120       !                             ! allocate flowri arrays 
    121       IF( flo_wri_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'flo_wri : unable to allocate arrays' ) 
    122       ! 
    123       !                             ! allocate florst arrays 
    124       IF( flo_rst_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'flo_rst : unable to allocate arrays' ) 
    125       ! 
    126       jpnrstflo = jpnfl-jpnnewflo   ! memory allocation  
    127       ! 
    128       DO jfl = 1, jpnfl             ! vertical axe for netcdf IOM ouput 
    129          nfloat(jfl) = jfl  
    130       END DO 
    131       ! 
    132       CALL flo_dom                  ! compute/read initial position of floats 
    133       ! 
    134       wb(:,:,:) = wn(:,:,:)         ! set wb for computation of floats trajectories at the first time step 
    135       ! 
     114      IF( ln_floats ) THEN 
     115         !                             ! allocate floats arrays 
     116         IF( flo_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'flo_init : unable to allocate arrays' ) 
     117         ! 
     118         !                             ! allocate flodom arrays 
     119         IF( flo_dom_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'flo_dom : unable to allocate arrays' ) 
     120         ! 
     121         !                             ! allocate flowri arrays 
     122         IF( flo_wri_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'flo_wri : unable to allocate arrays' ) 
     123         ! 
     124         !                             ! allocate florst arrays 
     125         IF( flo_rst_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'flo_rst : unable to allocate arrays' ) 
     126         ! 
     127         jpnrstflo = jpnfl-jpnnewflo   ! memory allocation  
     128         ! 
     129         DO jfl = 1, jpnfl             ! vertical axe for netcdf IOM ouput 
     130            nfloat(jfl) = jfl  
     131         END DO 
     132         ! 
     133         CALL flo_dom( Kmm )           ! compute/read initial position of floats 
     134         ! 
     135         wb(:,:,:) = ww(:,:,:)         ! set wb for computation of floats trajectories at the first time step 
     136         ! 
     137      ENDIF 
    136138   END SUBROUTINE flo_init 
    137  
    138 #  else 
    139    !!---------------------------------------------------------------------- 
    140    !!   Default option :                                       Empty module 
    141    !!---------------------------------------------------------------------- 
    142 CONTAINS 
    143    SUBROUTINE flo_stp( kt )          ! Empty routine 
    144       IMPLICIT NONE 
    145       INTEGER, INTENT( in ) :: kt 
    146       WRITE(*,*) 'flo_stp: You should not have seen this print! error?', kt 
    147    END SUBROUTINE flo_stp 
    148    SUBROUTINE flo_init          ! Empty routine 
    149       IMPLICIT NONE 
    150    END SUBROUTINE flo_init 
    151 #endif 
    152139 
    153140   !!====================================================================== 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/FLO/floblk.F90

    r10425 r13463  
    44   !! Ocean floats :   trajectory computation 
    55   !!====================================================================== 
    6 #if   defined key_floats 
    7    !!---------------------------------------------------------------------- 
    8    !!   'key_floats'                                     float trajectories 
     6   !! 
    97   !!---------------------------------------------------------------------- 
    108   !!    flotblk     : compute float trajectories with Blanke algorithme 
    … …  
    2220   PUBLIC   flo_blk    ! routine called by floats.F90 
    2321 
     22#  include "domzgr_substitute.h90" 
     23 
    2424   !!---------------------------------------------------------------------- 
    2525   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    2929CONTAINS 
    3030 
    31    SUBROUTINE flo_blk( kt ) 
     31   SUBROUTINE flo_blk( kt, Kbb, Kmm ) 
    3232      !!--------------------------------------------------------------------- 
    3333      !!                  ***  ROUTINE flo_blk  *** 
    … …  
    4040      !!      of the floats and the grid defined on the domain. 
    4141      !!---------------------------------------------------------------------- 
    42       INTEGER, INTENT( in  ) ::   kt ! ocean time step 
     42      INTEGER, INTENT( in  ) ::   kt       ! ocean time step 
     43      INTEGER, INTENT( in  ) ::   Kbb, Kmm ! ocean time level indices 
    4344      !! 
     45#ifndef key_agrif 
     46 
     47!RB super quick fix to compile with agrif 
     48 
    4449      INTEGER :: jfl              ! dummy loop arguments 
    4550      INTEGER :: ind, ifin, iloop 
    … …  
    101106222   DO jfl = 1, jpnfl 
    102107# if   defined key_mpp_mpi 
    103          IF( iil(jfl) >= mig(nldi) .AND. iil(jfl) <= mig(nlei) .AND.   & 
    104              ijl(jfl) >= mjg(nldj) .AND. ijl(jfl) <= mjg(nlej)   ) THEN 
     108         IF( iil(jfl) >= mig(Nis0) .AND. iil(jfl) <= mig(Nie0) .AND.   & 
     109             ijl(jfl) >= mjg(Njs0) .AND. ijl(jfl) <= mjg(Nje0)   ) THEN 
    105110            iiloc(jfl) = iil(jfl) - mig(1) + 1 
    106111            ijloc(jfl) = ijl(jfl) - mjg(1) + 1 
    … …  
    112117            ! compute the transport across the mesh where the float is.             
    113118!!bug (gm) change e3t into e3. but never checked  
    114             zsurfx(1) = e2u(iiloc(jfl)-1,ijloc(jfl)  ) * e3u_n(iiloc(jfl)-1,ijloc(jfl)  ,-ikl(jfl)) 
    115             zsurfx(2) = e2u(iiloc(jfl)  ,ijloc(jfl)  ) * e3u_n(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl)) 
    116             zsurfy(1) = e1v(iiloc(jfl)  ,ijloc(jfl)-1) * e3v_n(iiloc(jfl)  ,ijloc(jfl)-1,-ikl(jfl)) 
    117             zsurfy(2) = e1v(iiloc(jfl)  ,ijloc(jfl)  ) * e3v_n(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl)) 
     119            zsurfx(1) =   & 
     120            &   e2u(iiloc(jfl)-1,ijloc(jfl)  )    & 
     121            & * e3u(iiloc(jfl)-1,ijloc(jfl)  ,-ikl(jfl),Kmm) 
     122            zsurfx(2) =   & 
     123            &   e2u(iiloc(jfl)  ,ijloc(jfl)  )    & 
     124            & * e3u(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl),Kmm) 
     125            zsurfy(1) =   & 
     126            &   e1v(iiloc(jfl)  ,ijloc(jfl)-1)    & 
     127            & * e3v(iiloc(jfl)  ,ijloc(jfl)-1,-ikl(jfl),Kmm) 
     128            zsurfy(2) =   & 
     129            &   e1v(iiloc(jfl)  ,ijloc(jfl)  )    & 
     130            & * e3v(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl),Kmm) 
    118131 
    119132            ! for a isobar float zsurfz is put to zero. The vertical velocity will be zero too. 
    120133            zsurfz =          e1e2t(iiloc(jfl),ijloc(jfl)) 
    121             zvol   = zsurfz * e3t_n(iiloc(jfl),ijloc(jfl),-ikl(jfl)) 
     134            zvol   = zsurfz * e3t(iiloc(jfl),ijloc(jfl),-ikl(jfl),Kmm) 
    122135 
    123136            ! 
    124             zuinfl =( ub(iiloc(jfl)-1,ijloc(jfl),-ikl(jfl)) + un(iiloc(jfl)-1,ijloc(jfl),-ikl(jfl)) )/2.*zsurfx(1) 
    125             zuoutfl=( ub(iiloc(jfl)  ,ijloc(jfl),-ikl(jfl)) + un(iiloc(jfl)  ,ijloc(jfl),-ikl(jfl)) )/2.*zsurfx(2) 
    126             zvinfl =( vb(iiloc(jfl),ijloc(jfl)-1,-ikl(jfl)) + vn(iiloc(jfl),ijloc(jfl)-1,-ikl(jfl)) )/2.*zsurfy(1) 
    127             zvoutfl=( vb(iiloc(jfl),ijloc(jfl)  ,-ikl(jfl)) + vn(iiloc(jfl),ijloc(jfl)  ,-ikl(jfl)) )/2.*zsurfy(2) 
     137            zuinfl =( uu(iiloc(jfl)-1,ijloc(jfl),-ikl(jfl),Kbb) + uu(iiloc(jfl)-1,ijloc(jfl),-ikl(jfl),Kmm) )/2.*zsurfx(1) 
     138            zuoutfl=( uu(iiloc(jfl)  ,ijloc(jfl),-ikl(jfl),Kbb) + uu(iiloc(jfl)  ,ijloc(jfl),-ikl(jfl),Kmm) )/2.*zsurfx(2) 
     139            zvinfl =( vv(iiloc(jfl),ijloc(jfl)-1,-ikl(jfl),Kbb) + vv(iiloc(jfl),ijloc(jfl)-1,-ikl(jfl),Kmm) )/2.*zsurfy(1) 
     140            zvoutfl=( vv(iiloc(jfl),ijloc(jfl)  ,-ikl(jfl),Kbb) + vv(iiloc(jfl),ijloc(jfl)  ,-ikl(jfl),Kmm) )/2.*zsurfy(2) 
    128141            zwinfl =-(wb(iiloc(jfl),ijloc(jfl),-(ikl(jfl)-1))    & 
    129                &   +  wn(iiloc(jfl),ijloc(jfl),-(ikl(jfl)-1)) )/2. *  zsurfz*nisobfl(jfl) 
     142               &   +  ww(iiloc(jfl),ijloc(jfl),-(ikl(jfl)-1)) )/2. *  zsurfz*nisobfl(jfl) 
    130143            zwoutfl=-(wb(iiloc(jfl),ijloc(jfl),- ikl(jfl)   )   & 
    131                &   +  wn(iiloc(jfl),ijloc(jfl),- ikl(jfl)   ) )/2. *  zsurfz*nisobfl(jfl) 
     144               &   +  ww(iiloc(jfl),ijloc(jfl),- ikl(jfl)   ) )/2. *  zsurfz*nisobfl(jfl) 
    132145             
    133146            ! interpolation of velocity field on the float initial position             
    … …  
    176189            zgidfl(jfl) = float(iioutfl(jfl) - iiinfl(jfl)) 
    177190            IF( zufl(jfl)*zuoutfl <= 0. ) THEN 
    178                ztxfl(jfl) = 1.E99 
     191               ztxfl(jfl) = HUGE(1._wp) 
    179192            ELSE 
    180193               IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN 
    … …  
    192205            zgjdfl(jfl) = float(ijoutfl(jfl)-ijinfl(jfl)) 
    193206            IF( zvfl(jfl)*zvoutfl <= 0. ) THEN 
    194                ztyfl(jfl) = 1.E99 
     207               ztyfl(jfl) = HUGE(1._wp) 
    195208            ELSE 
    196209               IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN 
    … …  
    209222               zgkdfl(jfl) = float(ikoutfl(jfl) - ikinfl(jfl)) 
    210223               IF( zwfl(jfl)*zwoutfl <= 0. ) THEN 
    211                   ztzfl(jfl) = 1.E99 
     224                  ztzfl(jfl) = HUGE(1._wp) 
    212225               ELSE 
    213226                  IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN 
    … …  
    234247            ! test to know if the "age" of the float is not bigger than the  
    235248            ! time step 
    236             IF( zagenewfl(jfl) > rdt ) THEN 
    237                zttfl(jfl) = (rdt-zagefl(jfl)) / zvol 
    238                zagenewfl(jfl) = rdt 
     249            IF( zagenewfl(jfl) > rn_Dt ) THEN 
     250               zttfl(jfl) = (rn_Dt-zagefl(jfl)) / zvol 
     251               zagenewfl(jfl) = rn_Dt 
    239252            ENDIF 
    240253             
    … …  
    341354         ifin = 1 
    342355         DO jfl = 1, jpnfl 
    343             IF( zagefl(jfl) < rdt )   ifin = 0 
     356            IF( zagefl(jfl) < rn_Dt )   ifin = 0 
    344357            tpifl(jfl) = zgifl(jfl) + 0.5 
    345358            tpjfl(jfl) = zgjfl(jfl) + 0.5 
    … …  
    348361         ifin = 1 
    349362         DO jfl = 1, jpnfl 
    350             IF( zagefl(jfl) < rdt )   ifin = 0 
     363            IF( zagefl(jfl) < rn_Dt )   ifin = 0 
    351364            tpifl(jfl) = zgifl(jfl) + 0.5 
    352365            tpjfl(jfl) = zgjfl(jfl) + 0.5 
    … …  
    365378         GO TO 222 
    366379      ENDIF 
     380#endif 
    367381      ! 
    368382      ! 
    369383   END SUBROUTINE flo_blk 
    370384 
    371 #  else 
    372    !!---------------------------------------------------------------------- 
    373    !!   Default option                                         Empty module 
    374    !!---------------------------------------------------------------------- 
    375 CONTAINS 
    376    SUBROUTINE flo_blk                  ! Empty routine 
    377    END SUBROUTINE flo_blk  
    378 #endif 
    379     
    380385   !!====================================================================== 
    381386END MODULE floblk  

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/FLO/flodom.F90

    r10425 r13463  
    66   !! History :  OPA  ! 1998-07 (Y.Drillet, CLIPPER)  Original code 
    77   !!  NEMO      3.3  ! 2011-09 (C.Bricaud,S.Law-Chune Mercator-Ocean): add ARIANE convention + comsecitc changes 
    8    !!---------------------------------------------------------------------- 
    9 #if   defined key_floats 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_floats'                                     float trajectories 
    128   !!---------------------------------------------------------------------- 
    139   !!   flo_dom               : initialization of floats 
    … …  
    4440CONTAINS 
    4541 
    46    SUBROUTINE flo_dom 
     42   SUBROUTINE flo_dom( Kmm ) 
    4743      !! --------------------------------------------------------------------- 
    4844      !!                  ***  ROUTINE flo_dom  *** 
    … …  
    5349      !!               the longitude (degree) and the depth (m). 
    5450      !!----------------------------------------------------------------------       
     51      INTEGER, INTENT(in) ::  Kmm    ! ocean time level index 
     52      ! 
    5553      INTEGER            ::   jfl    ! dummy loop   
    5654      INTEGER            ::   inum   ! logical unit for file read 
    … …  
    9492                CALL flo_add_new_ariane_floats(jpnrstflo+1,jpnfl)  
    9593            ELSE                 !Add new floats with long/lat convention 
    96                 CALL flo_add_new_floats(jpnrstflo+1,jpnfl) 
     94                CALL flo_add_new_floats(Kmm,jpnrstflo+1,jpnfl) 
    9795            ENDIF 
    9896         ENDIF 
    … …  
    106104            CALL flo_add_new_ariane_floats(1,jpnfl) 
    107105         ELSE                      !Add new floats with long/lat convention 
    108             CALL flo_add_new_floats(1,jpnfl) 
     106            CALL flo_add_new_floats(Kmm,1,jpnfl) 
    109107         ENDIF 
    110108 
    … …  
    113111   END SUBROUTINE flo_dom 
    114112 
    115    SUBROUTINE flo_add_new_floats(kfl_start, kfl_end) 
     113   SUBROUTINE flo_add_new_floats(Kmm, kfl_start, kfl_end) 
    116114      !! ------------------------------------------------------------- 
    117115      !!                 ***  SUBROUTINE add_new_arianefloats  *** 
    … …  
    128126      !! ** Method  :  
    129127      !!---------------------------------------------------------------------- 
     128      INTEGER, INTENT(in) :: Kmm 
    130129      INTEGER, INTENT(in) :: kfl_start, kfl_end 
    131130      !! 
    … …  
    156155         ikmfl(jfl) = 0 
    157156# if   defined key_mpp_mpi 
    158          DO ji = MAX(nldi,2), nlei 
    159             DO jj = MAX(nldj,2), nlej   ! NO vector opt. 
     157         DO ji = MAX(Nis0,2), Nie0 
     158            DO jj = MAX(Njs0,2), Nje0   ! NO vector opt. 
    160159# else          
    161160         DO ji = 2, jpi 
    … …  
    174173                  ihtest(jfl) = ihtest(jfl)+1 
    175174                  DO jk = 1, jpk-1 
    176                      IF( (gdepw_n(ji,jj,jk) <= flzz(jfl)) .AND. (gdepw_n(ji,jj,jk+1) > flzz(jfl)) ) THEN 
     175                     IF( (gdepw(ji,jj,jk,Kmm) <= flzz(jfl)) .AND. (gdepw(ji,jj,jk+1,Kmm) > flzz(jfl)) ) THEN 
    177176                        ikmfl(jfl) = jk 
    178177                        ivtest(jfl) = ivtest(jfl) + 1 
    … …  
    236235            zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-1) 
    237236            zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-1) 
    238             zgkfl(jfl) = (( gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl))   & 
    239                &                 / (  gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              & 
    240                &                    - gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ) )                             & 
    241                &                 + (( flzz(jfl)-gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) *(ikmfl(jfl)+1))   & 
    242                &                 / (  gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              & 
    243                &                    - gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) 
     237            zgkfl(jfl) = (( gdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1,Kmm) - flzz(jfl) )* ikmfl(jfl))   & 
     238               &                 / (  gdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1,Kmm)                              & 
     239               &                    - gdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ,Kmm) )                             & 
     240               &                 + (( flzz(jfl)-gdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl),Kmm) ) *(ikmfl(jfl)+1))   & 
     241               &                 / (  gdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1,Kmm)                              & 
     242               &                    - gdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl),Kmm) ) 
    244243         ELSE 
    245244            zgifl(jfl) = 0.e0 
    … …  
    437436      IF( ABS(dlx) > 1.0_wp ) dlx = 1.0_wp 
    438437      ! 
    439       dld = ATAN(DSQRT( 1._wp * ( 1._wp-dlx )/( 1._wp+dlx ) )) * 222.24_wp / dls 
     438      dld = ATAN(SQRT( 1._wp * ( 1._wp-dlx )/( 1._wp+dlx ) )) * 222.24_wp / dls 
    440439      flo_dstnce = dld * 1000._wp 
    441440      ! 
    … …  
    455454   END FUNCTION flo_dom_alloc 
    456455 
    457  
    458 #else 
    459    !!---------------------------------------------------------------------- 
    460    !!   Default option                                         Empty module 
    461    !!---------------------------------------------------------------------- 
    462 CONTAINS 
    463    SUBROUTINE flo_dom                 ! Empty routine 
    464          WRITE(*,*) 'flo_dom: : You should not have seen this print! error?' 
    465    END SUBROUTINE flo_dom 
    466 #endif 
    467  
    468456   !!====================================================================== 
    469457END MODULE flodom 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/FLO/florst.F90

    r10425 r13463  
    88   !!   NEMO      1.0  !  2002-10  (A. Bozec)  F90 : Free form and module 
    99   !!             3.2  !  2010-08  (slaw, cbricaud): netcdf outputs and others  
    10    !!---------------------------------------------------------------------- 
    11 #if   defined key_floats 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_floats'                                     float trajectories 
    1410   !!---------------------------------------------------------------------- 
    1511   USE flo_oce         ! ocean drifting floats 
    … …  
    10298         IF( lk_mpp ) THEN 
    10399            DO jfl = 1, jpnfl 
    104                IF( (INT(tpifl(jfl)) >= mig(nldi)) .AND.   & 
    105                   &(INT(tpifl(jfl)) <= mig(nlei)) .AND.   & 
    106                   &(INT(tpjfl(jfl)) >= mjg(nldj)) .AND.   & 
    107                   &(INT(tpjfl(jfl)) <= mjg(nlej)) ) THEN 
     100               IF( (INT(tpifl(jfl)) >= mig(Nis0)) .AND.   & 
     101                  &(INT(tpifl(jfl)) <= mig(Nie0)) .AND.   & 
     102                  &(INT(tpjfl(jfl)) >= mjg(Njs0)) .AND.   & 
     103                  &(INT(tpjfl(jfl)) <= mjg(Nje0)) ) THEN 
    108104                  iperproc(narea) = iperproc(narea)+1 
    109105               ENDIF 
    … …  
    125121   END SUBROUTINE flo_rst 
    126122 
    127 #  else 
    128    !!---------------------------------------------------------------------- 
    129    !!   Default option                                         Empty module 
    130    !!---------------------------------------------------------------------- 
    131 CONTAINS 
    132    SUBROUTINE flo_rst                 ! Empty routine 
    133    END SUBROUTINE flo_rst 
    134 #endif 
    135  
    136123   !!======================================================================= 
    137124END MODULE florst 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/FLO/flowri.F90

    r10425 r13463  
    1111   !!             3.2  !  2010-08  (slaw, cbricaud): netcdf outputs and others  
    1212   !!---------------------------------------------------------------------- 
    13 #if   defined key_floats 
    14    !!---------------------------------------------------------------------- 
    15    !!   'key_floats'                                     float trajectories 
    16    !!---------------------------------------------------------------------- 
    1713   USE flo_oce         ! ocean drifting floats 
    1814   USE oce             ! ocean dynamics and tracers 
    … …  
    5551   END FUNCTION flo_wri_alloc 
    5652 
    57    SUBROUTINE flo_wri( kt ) 
     53   SUBROUTINE flo_wri( kt, Kmm ) 
    5854      !!--------------------------------------------------------------------- 
    5955      !!                  ***  ROUTINE flo_wri *** 
    … …  
    6864      !!---------------------------------------------------------------------- 
    6965      !! * Arguments 
    70       INTEGER  :: kt                               ! time step 
     66      INTEGER, INTENT(in)  :: kt                 ! time step 
     67      INTEGER, INTENT(in)  :: Kmm                ! time level index 
    7168 
    7269      !! * Local declarations 
    … …  
    108105            ibfloc = mj1( ibfl ) 
    109106  
    110             IF( nldi <= iafloc .AND. iafloc <= nlei .AND. & 
    111               & nldj <= ibfloc .AND. ibfloc <= nlej       ) THEN  
     107            IF( Nis0 <= iafloc .AND. iafloc <= Nie0 .AND. & 
     108              & Njs0 <= ibfloc .AND. ibfloc <= Nje0       ) THEN  
    112109 
    113110               !the float is inside of current proc's area 
    … …  
    120117               zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   & 
    121118                     +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc) 
    122                zdep(jfl) = (1.-zcfl)*gdepw_n(iafloc,ibfloc,icfl ) + zcfl * gdepw_n(iafloc,ibfloc,ic1fl)      
     119               zdep(jfl) = (1.-zcfl)*gdepw(iafloc,ibfloc,icfl ,Kmm) + zcfl * gdepw(iafloc,ibfloc,ic1fl,Kmm)      
    123120 
    124121               !save temperature, salinity and density at this position 
    125                ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem) 
    126                zsal (jfl) = tsn(iafloc,ibfloc,icfl,jp_sal) 
    127                zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0 
     122               ztem(jfl) = ts(iafloc,ibfloc,icfl,jp_tem,Kmm) 
     123               zsal (jfl) = ts(iafloc,ibfloc,icfl,jp_sal,Kmm) 
     124               zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rho0 
    128125 
    129126            ENDIF 
    … …  
    141138            zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   & 
    142139                      +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc) 
    143             zdep(jfl) = (1.-zcfl)*gdepw_n(iafloc,ibfloc,icfl ) + zcfl * gdepw_n(iafloc,ibfloc,ic1fl) 
    144  
    145             ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem) 
    146             zsal(jfl) = tsn(iafloc,ibfloc,icfl,jp_sal) 
    147             zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0 
     140            zdep(jfl) = (1.-zcfl)*gdepw(iafloc,ibfloc,icfl ,Kmm) + zcfl * gdepw(iafloc,ibfloc,ic1fl,Kmm) 
     141 
     142            ztem(jfl) = ts(iafloc,ibfloc,icfl,jp_tem,Kmm) 
     143            zsal(jfl) = ts(iafloc,ibfloc,icfl,jp_sal,Kmm) 
     144            zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rho0 
    148145           
    149146         ENDIF 
    … …  
    179176               CALL ctl_opn( numflo, 'trajec_float', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    180177               irecflo = NINT( (nitend-nn_it000) / FLOAT(nn_writefl) ) 
    181                WRITE(numflo,*)cexper,no,irecflo,jpnfl,nn_writefl 
     178               WRITE(numflo,*) cexper, irecflo, jpnfl, nn_writefl 
    182179            ENDIF 
    183180 
    … …  
    225222               clname=TRIM(clname)//".nc" 
    226223 
    227                CALL fliocrfd( clname , (/ 'ntraj' , 't' /), (/ jpnfl , -1  /) , numflo ) 
     224               CALL fliocrfd( clname , (/'ntraj' , '    t' /), (/ jpnfl , -1/) , numflo ) 
    228225    
    229226               CALL fliodefv( numflo, 'traj_lon'    , (/1,2/), v_t=flio_r8, long_name="Longitude"           , units="degrees_east"  ) 
    … …  
    248245            !------------------------------- 
    249246            irec =  INT( (kt-nn_it000+1)/nn_writefl ) +1 
    250             ztime = ( kt-nn_it000 + 1 ) * rdt 
     247            ztime = ( kt-nn_it000 + 1 ) * rn_Dt 
    251248 
    252249            CALL flioputv( numflo , 'time_counter', ztime , start=(/irec/) ) 
    … …  
    255252 
    256253               istart = (/jfl,irec/) 
    257                icfl   = INT( tpkfl(jfl) )            ! K-index of the nearest point before 
    258  
    259                CALL flioputv( numflo , 'traj_lon'    , zlon(jfl)        , start=istart ) 
    260                CALL flioputv( numflo , 'traj_lat'    , zlat(jfl)        , start=istart )   
    261                CALL flioputv( numflo , 'traj_depth'  , zdep(jfl)        , start=istart )   
    262                CALL flioputv( numflo , 'traj_temp'   , ztemp(icfl,jfl)  , start=istart )   
    263                CALL flioputv( numflo , 'traj_salt'   , zsal(icfl,jfl)   , start=istart )   
    264                CALL flioputv( numflo , 'traj_dens'   , zrho(icfl,jfl)   , start=istart )   
     254 
     255               CALL flioputv( numflo , 'traj_lon'    , zlon(jfl), start=istart ) 
     256               CALL flioputv( numflo , 'traj_lat'    , zlat(jfl), start=istart )   
     257               CALL flioputv( numflo , 'traj_depth'  , zdep(jfl), start=istart )   
     258               CALL flioputv( numflo , 'traj_temp'   , ztem(jfl), start=istart )   
     259               CALL flioputv( numflo , 'traj_salt'   , zsal(jfl), start=istart )   
     260               CALL flioputv( numflo , 'traj_dens'   , zrho(jfl), start=istart )   
    265261 
    266262            ENDDO 
    … …  
    277273   END SUBROUTINE flo_wri 
    278274 
    279  
    280 #  else 
    281    !!---------------------------------------------------------------------- 
    282    !!   Default option                                         Empty module 
    283    !!---------------------------------------------------------------------- 
    284 CONTAINS 
    285    SUBROUTINE flo_wri                 ! Empty routine 
    286    END SUBROUTINE flo_wri 
    287 #endif 
    288  
    289275   !!======================================================================= 
    290276END MODULE flowri 
Note: See TracChangeset for help on using the changeset viewer.