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 16 for trunk/NEMO/OPA_SRC/FLO/flowri.F90 – NEMO

Ignore:
Timestamp:
2004-02-17T09:06:15+01:00 (20 years ago)
Author:
opalod
Message:

CT : UPDATE001 : First major NEMO update

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/OPA_SRC/FLO/flowri.F90

    r3 r16  
    1515   USE dom_oce         ! ocean space and time domain 
    1616   USE lib_mpp         ! distribued memory computing library 
     17   USE daymod 
    1718   USE in_out_manager  ! I/O manager 
    1819 
     
    5253 
    5354      !! * Local declarations 
     55      CHARACTER (len=21) ::  clname 
    5456      INTEGER ::   inum = 11       ! temporary logical unit for restart file 
    5557      INTEGER  ::   & 
     
    6264      REAL(wp) :: zafl,zbfl,zcfl,zdtj 
    6365      REAL(wp) :: zxxu, zxxu_01,zxxu_10, zxxu_11 
    64       REAL(wp) , DIMENSION ( jpk  , jpnfl) :: ztemp, zsal 
    65  
    66       CHARACTER (len=21) ::  clname 
     66      REAL(wp), DIMENSION (jpk,jpnfl) :: ztemp, zsal 
    6767      !!--------------------------------------------------------------------- 
    6868       
     
    8686            IF(lwp) WRITE(numflo)cexper,no,irecflo,jpnfl,nwritefl 
    8787         ENDIF 
    88          zdtj = rdt/86400.       
     88         zdtj = rdt / 86400.      !!bug   use of 86400 instead of the phycst parameter 
    8989 
    9090         ! translation of index position in geographical position 
    9191 
    92          DO jfl = 1, jpnfl 
    93             iafl  = INT (tpifl(jfl)) 
    94             ibfl  = INT (tpjfl(jfl)) 
    95             icfl  = INT (tpkfl(jfl)) 
    96             iafln = NINT(tpifl(jfl)) 
    97             ibfln = NINT(tpjfl(jfl)) 
    98             ia1fl = iafl+1 
    99             ib1fl = ibfl+1 
    100             ic1fl = icfl+1 
    101             zafl  = tpifl(jfl) - FLOAT(iafl) 
    102             zbfl  = tpjfl(jfl) - FLOAT(ibfl) 
    103             zcfl  = tpkfl(jfl) - FLOAT(icfl) 
    104 # if defined key_mpp 
    105             IF( (iafl >= (mig(nldi)-jpizoom+1)) .AND. (iafl <= (mig(nlei)-jpizoom+1)) .AND.   & 
    106               (  ibfl >= (mjg(nldj)-jpjzoom+1)) .AND. (ibfl <= (mjg(nlej)-jpjzoom+1)) ) THEN 
    107  
    108                ! local index 
    109  
    110                iafloc  = iafl -(mig(1)-jpizoom+1) + 1 
    111                ibfloc  = ibfl -(mjg(1)-jpjzoom+1) + 1 
     92         IF( lk_mpp ) THEN 
     93            DO jfl = 1, jpnfl 
     94               iafl  = INT ( tpifl(jfl) ) 
     95               ibfl  = INT ( tpjfl(jfl) ) 
     96               icfl  = INT ( tpkfl(jfl) ) 
     97               iafln = NINT( tpifl(jfl) ) 
     98               ibfln = NINT( tpjfl(jfl) ) 
     99               ia1fl = iafl + 1 
     100               ib1fl = ibfl + 1 
     101               ic1fl = icfl + 1 
     102               zafl  = tpifl(jfl) - FLOAT( iafl ) 
     103               zbfl  = tpjfl(jfl) - FLOAT( ibfl ) 
     104               zcfl  = tpkfl(jfl) - FLOAT( icfl ) 
     105               IF(   iafl >= mig(nldi)-jpizoom+1 .AND. iafl <= mig(nlei)-jpizoom+1 .AND.   & 
     106                  &  ibfl >= mjg(nldj)-jpjzoom+1 .AND. ibfl <= mjg(nlej)-jpjzoom+1       ) THEN 
     107 
     108                  ! local index 
     109 
     110                  iafloc  = iafl -(mig(1)-jpizoom+1) + 1 
     111                  ibfloc  = ibfl -(mjg(1)-jpjzoom+1) + 1 
     112                  ia1floc = iafloc + 1 
     113                  ib1floc = ibfloc + 1 
     114 
     115                  flyy(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc)   & 
     116                     &      +     zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) +     zafl  * zbfl * gphit(ia1floc,ib1floc) 
     117                  flxx(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   & 
     118                     &      +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc) 
     119                  flzz(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 
     120 
     121                  ! Change  by Alexandra Bozec et Jean-Philippe Boulanger 
     122                  ! We save  the instantaneous profile of T and S of the column      
     123                  ! ztemp(jfl)=tn(iafloc,ibfloc,icfl) 
     124                  ! zsal(jfl)=sn(iafloc,ibfloc,icfl) 
     125                  ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 
     126                  zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk)             
     127               ELSE 
     128                  flxx(jfl) = 0. 
     129                  flyy(jfl) = 0. 
     130                  flzz(jfl) = 0. 
     131                  ztemp(1:jpk,jfl) = 0. 
     132                  zsal (1:jpk,jfl) = 0. 
     133               ENDIF 
     134            END DO 
     135 
     136            CALL mpp_sum( flxx, jpnfl )   ! sums over the global domain 
     137            CALL mpp_sum( flyy, jpnfl ) 
     138            CALL mpp_sum( flzz, jpnfl ) 
     139            ! these 2 lines have accendentaly been removed from ATL6-V8 run hence 
     140            ! giving 0 salinity and temperature on the float trajectory 
     141            CALL mpp_sum( ztemp, jpk*jpnfl ) 
     142            CALL mpp_sum( zsal , jpk*jpnfl ) 
     143 
     144         ELSE 
     145            DO jfl = 1, jpnfl 
     146               iafl  = INT (tpifl(jfl)) 
     147               ibfl  = INT (tpjfl(jfl)) 
     148               icfl  = INT (tpkfl(jfl)) 
     149               iafln = NINT(tpifl(jfl)) 
     150               ibfln = NINT(tpjfl(jfl)) 
     151               ia1fl = iafl+1 
     152               ib1fl = ibfl+1 
     153               ic1fl = icfl+1 
     154               zafl  = tpifl(jfl) - FLOAT(iafl) 
     155               zbfl  = tpjfl(jfl) - FLOAT(ibfl) 
     156               zcfl  = tpkfl(jfl) - FLOAT(icfl) 
     157               iafloc  = iafl 
     158               ibfloc  = ibfl 
    112159               ia1floc = iafloc + 1 
    113160               ib1floc = ibfloc + 1 
     
    118165                         +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc) 
    119166               flzz(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 
    120  
     167               !ALEX 
     168               ! Astuce pour ne pas avoir des flotteurs qui se baladent sur IDL 
     169               zxxu_11 = glamt(iafloc ,ibfloc ) 
     170               zxxu_10 = glamt(iafloc ,ib1floc) 
     171               zxxu_01 = glamt(ia1floc,ibfloc ) 
     172               zxxu    = glamt(ia1floc,ib1floc) 
     173 
     174               IF( iafloc == 52 )  zxxu_10 = -181 
     175               IF( iafloc == 52 )  zxxu_11 = -181 
     176               flxx(jfl)=(1.-zafl)*(1.-zbfl)* zxxu_11 + (1.-zafl)*    zbfl * zxxu_10   & 
     177                        +    zafl *(1.-zbfl)* zxxu_01 +     zafl *    zbfl * zxxu 
     178               !ALEX          
    121179               ! Change  by Alexandra Bozec et Jean-Philippe Boulanger 
    122180               ! We save  the instantaneous profile of T and S of the column      
    123                ! ztemp(jfl)=tn(iafloc,ibfloc,icfl) 
    124                ! zsal(jfl)=sn(iafloc,ibfloc,icfl) 
     181               !     ztemp(jfl)=tn(iafloc,ibfloc,icfl) 
     182               !     zsal(jfl)=sn(iafloc,ibfloc,icfl) 
    125183               ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 
    126                zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk)             
    127             ELSE 
    128                flxx(jfl) = 0. 
    129                flyy(jfl) = 0. 
    130                flzz(jfl) = 0. 
    131                ztemp(1:jpk,jfl) = 0. 
    132                zsal (1:jpk,jfl) = 0. 
    133             ENDIF 
    134 # else 
    135             iafloc  = iafl 
    136             ibfloc  = ibfl 
    137             ia1floc = iafloc + 1 
    138             ib1floc = ibfloc + 1 
    139             ! 
    140             flyy(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc)   & 
    141                       +     zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) +     zafl  * zbfl * gphit(ia1floc,ib1floc) 
    142             flxx(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   & 
    143                       +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc) 
    144             flzz(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 
    145             !ALEX 
    146             ! Astuce pour ne pas avoir des flotteurs qui se baladent sur IDL 
    147             zxxu_11 = glamt(iafloc ,ibfloc ) 
    148             zxxu_10 = glamt(iafloc ,ib1floc) 
    149             zxxu_01 = glamt(ia1floc,ibfloc ) 
    150             zxxu    = glamt(ia1floc,ib1floc) 
    151  
    152             IF( iafloc == 52 )  zxxu_10 = -181 
    153             IF( iafloc == 52 )  zxxu_11 = -181 
    154             flxx(jfl)=(1.-zafl)*(1.-zbfl)* zxxu_11 + (1.-zafl)*    zbfl * zxxu_10   & 
    155                      +    zafl *(1.-zbfl)* zxxu_01 +     zafl *    zbfl * zxxu 
    156             !ALEX          
    157             ! Change  by Alexandra Bozec et Jean-Philippe Boulanger 
    158             ! We save  the instantaneous profile of T and S of the column      
    159             !     ztemp(jfl)=tn(iafloc,ibfloc,icfl) 
    160             !     zsal(jfl)=sn(iafloc,ibfloc,icfl) 
    161             ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 
    162             zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk) 
    163 # endif 
    164          END DO 
    165  
    166 # if defined key_mpp 
    167          CALL mpp_sum( flxx, jpnfl ) 
    168          CALL mpp_sum( flyy, jpnfl ) 
    169          CALL mpp_sum( flzz, jpnfl ) 
    170          ! these 2 lines have accendentaly been removed from ATL6-V8 run hence 
    171          ! giving 0 salinity and temperature on the float trajectory 
    172          CALL mpp_sum( ztemp, jpk*jpnfl ) 
    173          CALL mpp_sum( zsal , jpk*jpnfl ) 
    174  
    175 # endif 
     184               zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk) 
     185            END DO 
     186         ENDIF 
     187 
    176188         ! 
    177189         WRITE(numflo) flxx,flyy,flzz,nisobfl,ngrpfl,ztemp,zsal, FLOAT(ndastp) 
     
    187199      !         iafln=NINT(tpifl(jfl)) 
    188200      !         ibfln=NINT(tpjfl(jfl)) 
    189       !# if defined key_mpp 
     201      !# if defined key_mpp_mpi   ||   defined key_mpp_shmem 
    190202      !        IF ( (iafl >= (mig(nldi)-jpizoom+1)) .AND. 
    191203      !     $       (iafl <= (mig(nlei)-jpizoom+1)) .AND. 
     
    206218      !         ztemp(jfl)=tn(iafloc,ibfloc,jk) 
    207219      !         zsal(jfl)=sn(iaflo!,ibfloc,jk) 
    208       !# if defined key_mpp 
     220      !# if defined key_mpp_mpi   ||   defined key_mpp_shmem 
    209221      !        ELSE 
    210222      !         ztemp(jfl) = 0. 
     
    214226      !! ... next float 
    215227      !        END DO 
    216       !#if defined key_mpp 
    217       !      CALL mpp_sum( ztemp, jpnfl ) 
    218       !      CALL mpp_sum( zsal , jpnfl ) 
    219       !# endif 
     228      !      IF( lk_mpp )   CALL mpp_sum( ztemp, jpnfl ) 
     229      !      IF( lk_mpp )   CALL mpp_sum( zsal , jpnfl ) 
     230      ! 
    220231      !      IF (lwp) THEN  
    221232      !         WRITE(numflo) ztemp, zsal 
     
    268279         ! Compute the number of trajectories for each processor 
    269280         ! 
    270 # if defined key_mpp 
    271          DO jfl = 1, jpnfl 
    272             IF( (INT(tpifl(jfl)) >= (mig(nldi)-jpizoom+1)) .AND.   & 
    273               (  INT(tpifl(jfl)) <= (mig(nlei)-jpizoom+1)) .AND.   & 
    274               (  INT(tpjfl(jfl)) >= (mjg(nldj)-jpjzoom+1)) .AND.   & 
    275               (  INT(tpjfl(jfl)) <= (mjg(nlej)-jpjzoom+1)) ) THEN 
    276                iproc(narea) = iproc(narea)+1 
    277             ENDIF 
    278          END DO 
    279          CALL mpp_sum( iproc, jpnij ) 
    280          ! 
    281          IF(lwp) THEN  
    282             WRITE(numout,*) 'DATE',adatrj 
    283             DO jpn = 1, jpnij 
    284                IF( iproc(jpn) /= 0 ) THEN 
    285                   WRITE(numout,*)'PROCESSOR',jpn-1,'compute',iproc(jpn), 'trajectories.' 
     281         IF( lk_mpp ) THEN 
     282            DO jfl = 1, jpnfl 
     283               IF( (INT(tpifl(jfl)) >= (mig(nldi)-jpizoom+1)) .AND.   & 
     284                  &(INT(tpifl(jfl)) <= (mig(nlei)-jpizoom+1)) .AND.   & 
     285                  &(INT(tpjfl(jfl)) >= (mjg(nldj)-jpjzoom+1)) .AND.   & 
     286                  &(INT(tpjfl(jfl)) <= (mjg(nlej)-jpjzoom+1)) ) THEN 
     287                  iproc(narea) = iproc(narea)+1 
    286288               ENDIF 
    287289            END DO 
    288          ENDIF 
    289 # endif 
     290            CALL mpp_sum( iproc, jpnij ) 
     291            ! 
     292            IF(lwp) THEN  
     293               WRITE(numout,*) 'DATE',adatrj 
     294               DO jpn = 1, jpnij 
     295                  IF( iproc(jpn) /= 0 ) THEN 
     296                     WRITE(numout,*)'PROCESSOR',jpn-1,'compute',iproc(jpn), 'trajectories.' 
     297                  ENDIF 
     298               END DO 
     299            ENDIF 
     300         ENDIF 
    290301      ENDIF  
    291302 
Note: See TracChangeset for help on using the changeset viewer.