Ignore:
Timestamp:
2011-09-15T08:41:58+02:00 (9 years ago)
Author:
cbricaud
Message:

modified routine for netcdf output

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90

    r2715 r2839  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  flowri  *** 
    4    !! lagrangian floats :   outputs 
     4   !! blablabla: floteur.... 
    55   !!====================================================================== 
    6    !! History :   OPA  ! 1999-09  (Y. Drillet)  Original code 
    7    !!                  ! 2000-06  (J.-M. Molines)  Profiling floats for CLS  
    8    !!   NEMO      1.0  ! 2002-11  (G. Madec, A. Bozec)  F90: Free form and module 
     6   !!  History : 
     7   !!    8.0  !  99-09  (Y. Drillet)    : Original code 
     8   !!         !  00-06  (J.-M. Molines) : Profiling floats for CLS  
     9   !!    8.5  !  02-10  (A. Bozec)  F90 : Free form and module 
     10   !!    3.2  !  10-08  (slaw, cbricaud): netcdf outputs and others  
    911   !!---------------------------------------------------------------------- 
    1012#if   defined key_floats   ||   defined key_esopa 
     
    1214   !!   'key_floats'                                     float trajectories 
    1315   !!---------------------------------------------------------------------- 
    14    !!    flowri     : write trajectories of floats in file  
    15    !!---------------------------------------------------------------------- 
     16 
     17   !! * Modules used 
    1618   USE flo_oce         ! ocean drifting floats 
    1719   USE oce             ! ocean dynamics and tracers 
     
    1921   USE lib_mpp         ! distribued memory computing library 
    2022   USE in_out_manager  ! I/O manager 
     23   USE phycst          ! physic constants 
     24   USE dianam          ! build name of file (routine) 
     25   USE ioipsl 
     26   USE iom             ! I/O library 
     27 
    2128 
    2229   IMPLICIT NONE 
    2330   PRIVATE 
    2431 
    25    PUBLIC   flo_wri         ! routine called by floats.F90 
    26    PUBLIC   flo_wri_alloc   ! routine called by floats.F90 
    27  
    28    INTEGER ::   jfl      ! number of floats 
    29    INTEGER ::   numflo   ! logical unit for drifting floats 
     32   PUBLIC flo_wri      ! routine called by floats.F90 
     33   PUBLIC flo_wri_alloc   ! routine called by floats.F90 
     34 
     35   INTEGER :: jfl      ! number of floats 
     36   CHARACTER (len=80)  :: clname             ! netcdf output filename 
    3037 
    3138   ! Following are only workspace arrays but shape is not (jpi,jpj) and 
    3239   ! therefore make them module arrays rather than replacing with wrk_nemo 
    3340   ! member arrays. 
    34    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ztemp, zsal   ! 2D workspace 
     41   REAL(wp), ALLOCATABLE, DIMENSION(:) ::   zlon , zlat, zdep   ! 2D workspace 
     42   REAL(wp), ALLOCATABLE, DIMENSION(:) ::   ztem, zsal, zrho   ! 2D workspace 
    3543 
    3644   !! * Substitutions 
    3745#  include "domzgr_substitute.h90" 
    3846   !!---------------------------------------------------------------------- 
    39    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    40    !! $Id$  
    41    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    42    !!---------------------------------------------------------------------- 
     47   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
     48   !! $Header: 
     49   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     50   !!---------------------------------------------------------------------- 
     51 
    4352CONTAINS 
    4453 
     
    4756      !!                ***  FUNCTION flo_wri_alloc  *** 
    4857      !!------------------------------------------------------------------- 
    49       ALLOCATE( ztemp(jpk,jpnfl) , zsal(jpk,jpnfl) , STAT=flo_wri_alloc) 
    50       ! 
     58      ALLOCATE( ztem(jpnfl) , zsal(jpnfl) , zrho(jpnfl) , & 
     59                zlon(jpnfl) , zlat(jpnfl) , zdep(jpnfl) , STAT=flo_wri_alloc) 
     60      !   
    5161      IF( lk_mpp             )   CALL mpp_sum ( flo_wri_alloc ) 
    5262      IF( flo_wri_alloc /= 0 )   CALL ctl_warn('flo_wri_alloc: failed to allocate arrays.') 
    5363   END FUNCTION flo_wri_alloc 
    5464 
    55  
    5665   SUBROUTINE flo_wri( kt ) 
    57       !!------------------------------------------------------------------- 
    58       !!                  ***  ROUTINE flo_wri  *** 
     66      !!--------------------------------------------------------------------- 
     67      !!                  ***  ROUTINE flo_wri *** 
    5968      !!              
    60       !! ** Purpose :   Write position of floats in "trajec_float" file 
    61       !!      and the temperature and salinity at this position 
     69      !! ** Purpose :   Write position of floats in "trajec_float.nc",according 
     70      !!                to ARIANE TOOLS (http://stockage.univ-brest.fr/~grima/Ariane/ )  n 
     71      !!                nomenclature 
     72      !!     
    6273      !!       
    63       !! ** Method  :   The frequency is nn_writefl 
     74      !! ** Method  :   The frequency of  ??? is nwritefl 
     75      !!       
    6476      !!---------------------------------------------------------------------- 
    65       INTEGER ::   kt   ! time step 
    66       !! 
    67       CHARACTER (len=21) ::  clname 
    68       INTEGER ::   inum   ! temporary logical unit for restart file 
    69       INTEGER ::   iafl, ibfl, icfl, ia1fl, ib1fl, ic1fl, jfl, irecflo 
    70       INTEGER ::   iafloc, ibfloc, ia1floc, ib1floc, iafln, ibfln 
    71       INTEGER  ::    ic, jc , jpn 
    72       INTEGER, DIMENSION ( jpnij )  ::   iproc 
    73       REAL(wp) ::   zafl, zbfl, zcfl, zdtj 
    74       REAL(wp) ::   zxxu, zxxu_01,zxxu_10, zxxu_11 
    75       !!--------------------------------------------------------------------- 
     77      !! * Arguments 
     78      INTEGER  :: kt                               ! time step 
     79 
     80      !! * Local declarations 
     81      INTEGER  :: iafl , ibfl , icfl             ! temporary integer 
     82      INTEGER  :: ia1fl, ib1fl, ic1fl            !   " 
     83      INTEGER  :: iafloc,ibfloc,ia1floc,ib1floc  !   " 
     84      INTEGER  :: irec, irecflo 
     85 
     86      REAL(wp) :: zafl,zbfl,zcfl                 ! temporary real 
     87      REAL(wp) :: ztime                          !   " 
     88      !REAL(wp) :: zxxu, zxxu_01,zxxu_10, zxxu_11 !   " 
     89 
     90      INTEGER, DIMENSION(2)          :: icount 
     91      INTEGER, DIMENSION(2)          :: istart 
     92 
     93      INTEGER, DIMENSION(1) ::   ish 
     94      INTEGER, DIMENSION(2) ::   ish2 
     95      REAL(wp), DIMENSION(jpnfl*jpk) ::   zwork   ! 1D workspace 
     96      !!---------------------------------------------------------------------- 
    7697       
    77       IF( kt == nit000 .OR. MOD( kt,nn_writefl) == 0 ) THEN  
    78  
    79          ! header of output floats file 
    80        
    81          IF(lwp) THEN 
    82             WRITE(numout,*) 
    83             WRITE(numout,*) 'flo_wri : write in trajec_float file ' 
    84             WRITE(numout,*) '~~~~~~~    ' 
    85          ENDIF 
    86  
    87          ! open the file numflo  
    88          CALL ctl_opn( numflo, 'trajec_float', 'REPLACE', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    89  
    90          IF( kt == nit000 ) THEN 
    91             irecflo = NINT( (nitend-nit000) / FLOAT(nn_writefl) ) 
    92             IF(lwp) WRITE(numflo)cexper,no,irecflo,jpnfl,nn_writefl 
    93          ENDIF 
    94          zdtj = rdt / 86400._wp 
    95  
    96          ! translation of index position in geographical position 
    97  
    98          IF( lk_mpp ) THEN 
    99             DO jfl = 1, jpnfl 
    100                iafl  = INT ( tpifl(jfl) ) 
    101                ibfl  = INT ( tpjfl(jfl) ) 
    102                icfl  = INT ( tpkfl(jfl) ) 
    103                iafln = NINT( tpifl(jfl) ) 
    104                ibfln = NINT( tpjfl(jfl) ) 
    105                ia1fl = iafl + 1 
    106                ib1fl = ibfl + 1 
    107                ic1fl = icfl + 1 
    108                zafl  = tpifl(jfl) - FLOAT( iafl ) 
    109                zbfl  = tpjfl(jfl) - FLOAT( ibfl ) 
    110                zcfl  = tpkfl(jfl) - FLOAT( icfl ) 
    111                IF(   iafl >= mig(nldi)-jpizoom+1 .AND. iafl <= mig(nlei)-jpizoom+1 .AND.   & 
    112                   &  ibfl >= mjg(nldj)-jpjzoom+1 .AND. ibfl <= mjg(nlej)-jpjzoom+1       ) THEN 
    113  
    114                   ! local index 
    115  
    116                   iafloc  = iafl -(mig(1)-jpizoom+1) + 1 
    117                   ibfloc  = ibfl -(mjg(1)-jpjzoom+1) + 1 
     98      !IF( MOD( kt,nn_writefl)== 0 ) THEN  
     99 
     100 
     101         !----------------------------------------------------- 
     102         ! I- Save positions, temperature, salinty and density  
     103         !----------------------------------------------------- 
     104         zlon(:)=0.0 ; zlat(:)=0.0 ; zdep(:)=0.0  
     105         ztem(:)=0.0 ; zsal(:)=0.0 ; zrho(:)=0.0  
     106 
     107         DO jfl = 1, jpnfl 
     108 
     109            iafl  = INT (tpifl(jfl))            ! I-index of the nearest point before 
     110            ibfl  = INT (tpjfl(jfl))            ! J-index of the nearest point before 
     111            icfl  = INT (tpkfl(jfl))            ! K-index of the nearest point before 
     112            ia1fl = iafl + 1                    ! I-index of the nearest point after 
     113            ib1fl = ibfl + 1                    ! J-index of the nearest point after 
     114            ic1fl = icfl + 1                    ! K-index of the nearest point after 
     115            zafl  = tpifl(jfl) - REAL(iafl,wp)  ! distance  ????? 
     116            zbfl  = tpjfl(jfl) - REAL(ibfl,wp)  ! distance  ????? 
     117            zcfl  = tpkfl(jfl) - REAL(icfl,wp)  ! distance  ????? 
     118 
     119            write(narea+200,*)'A', jfl,iafl,ibfl 
     120 
     121            IF( lk_mpp ) THEN 
     122                
     123               iafloc = mi1( iafl ) 
     124               ibfloc = mj1( ibfl ) 
     125  
     126               IF( nldi <= iafloc .AND. iafloc <= nlei .AND. & 
     127                 & nldj <= ibfloc .AND. ibfloc <= nlej       ) THEN  
     128 
     129                  write(narea+200,*)'B',jfl,iafloc,ibfloc,glamt(iafloc ,ibfloc ) 
     130                  write(narea+200,*)'B',zafl,zbfl 
     131 
     132                  !the float is inside of current proc's area 
    118133                  ia1floc = iafloc + 1 
    119134                  ib1floc = ibfloc + 1 
    120  
    121                   flyy(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc)   & 
    122                      &      +     zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) +     zafl  * zbfl * gphit(ia1floc,ib1floc) 
    123                   flxx(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   & 
    124                      &      +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc) 
    125                   flzz(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 
    126  
    127                   ! Change  by Alexandra Bozec et Jean-Philippe Boulanger 
    128                   ! We save  the instantaneous profile of T and S of the column      
    129                   ! ztemp(jfl)=tn(iafloc,ibfloc,icfl) 
    130                   ! zsal(jfl)=sn(iafloc,ibfloc,icfl) 
    131                   ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 
    132                   zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk)             
    133                ELSE 
    134                   flxx(jfl) = 0. 
    135                   flyy(jfl) = 0. 
    136                   flzz(jfl) = 0. 
    137                   ztemp(1:jpk,jfl) = 0. 
    138                   zsal (1:jpk,jfl) = 0. 
     135      
     136                  !save position of the float 
     137                  zlat(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc)   & 
     138                        +     zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) +     zafl  * zbfl * gphit(ia1floc,ib1floc)    
     139                  zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   & 
     140                        +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc) 
     141                  zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl)      
     142 
     143                  !save temperature, salinity and density at this position 
     144                  ztem(jfl) = tn(iafloc,ibfloc,icfl) 
     145                  zsal (jfl) = sn(iafloc,ibfloc,icfl) 
     146                  zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0 
     147             
     148               ELSE ! the float is not inside of current proc's area 
     149                  !write(narea+200,*)"notinside current proc: jfl ",jfl 
     150 
     151                  zlon(jfl) = 0. 
     152                  zlat(jfl) = 0. 
     153                  zdep(jfl) = 0. 
     154 
     155                  !ztemp(1:jpk,jfl) = 0. 
     156                  !zsal (1:jpk,jfl) = 0. 
     157                  !zrho (1:jpk,jfl) = 0. 
     158                  ztem(jfl) = 0. 
     159                  zsal (jfl) = 0. 
     160                  zrho (jfl) = 0. 
     161 
    139162               ENDIF 
    140             END DO 
    141  
    142             CALL mpp_sum( flxx, jpnfl )   ! sums over the global domain 
    143             CALL mpp_sum( flyy, jpnfl ) 
    144             CALL mpp_sum( flzz, jpnfl ) 
    145             ! these 2 lines have accendentaly been removed from ATL6-V8 run hence 
    146             ! giving 0 salinity and temperature on the float trajectory 
    147 !bug RB 
    148 !compilation failed in mpp 
    149 !            CALL mpp_sum( ztemp, jpk*jpnfl ) 
    150 !            CALL mpp_sum( zsal , jpk*jpnfl ) 
    151  
    152          ELSE 
    153             DO jfl = 1, jpnfl 
    154                iafl  = INT (tpifl(jfl)) 
    155                ibfl  = INT (tpjfl(jfl)) 
    156                icfl  = INT (tpkfl(jfl)) 
    157                iafln = NINT(tpifl(jfl)) 
    158                ibfln = NINT(tpjfl(jfl)) 
    159                ia1fl = iafl+1 
    160                ib1fl = ibfl+1 
    161                ic1fl = icfl+1 
    162                zafl  = tpifl(jfl) - FLOAT(iafl) 
    163                zbfl  = tpjfl(jfl) - FLOAT(ibfl) 
    164                zcfl  = tpkfl(jfl) - FLOAT(icfl) 
     163 
     164            ELSE  ! mono proc case   
     165 
    165166               iafloc  = iafl 
    166167               ibfloc  = ibfl 
    167168               ia1floc = iafloc + 1 
    168169               ib1floc = ibfloc + 1 
    169                ! 
    170                flyy(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc)   & 
     170 
     171               !save position of the float                
     172               zlat(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc)   & 
    171173                         +     zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) +     zafl  * zbfl * gphit(ia1floc,ib1floc) 
    172                flxx(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   & 
     174               zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   & 
    173175                         +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc) 
    174                flzz(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 
    175                !ALEX 
    176                ! Astuce pour ne pas avoir des flotteurs qui se baladent sur IDL 
    177                zxxu_11 = glamt(iafloc ,ibfloc ) 
    178                zxxu_10 = glamt(iafloc ,ib1floc) 
    179                zxxu_01 = glamt(ia1floc,ibfloc ) 
    180                zxxu    = glamt(ia1floc,ib1floc) 
    181  
    182                IF( iafloc == 52 )  zxxu_10 = -181 
    183                IF( iafloc == 52 )  zxxu_11 = -181 
    184                flxx(jfl)=(1.-zafl)*(1.-zbfl)* zxxu_11 + (1.-zafl)*    zbfl * zxxu_10   & 
    185                         +    zafl *(1.-zbfl)* zxxu_01 +     zafl *    zbfl * zxxu 
    186                !ALEX          
    187                ! Change  by Alexandra Bozec et Jean-Philippe Boulanger 
    188                ! We save  the instantaneous profile of T and S of the column      
    189                !     ztemp(jfl)=tn(iafloc,ibfloc,icfl) 
    190                !     zsal(jfl)=sn(iafloc,ibfloc,icfl) 
    191                ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 
    192                zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk) 
    193             END DO 
     176               zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 
     177 
     178               ztem(jfl) = tn(iafloc,ibfloc,icfl) 
     179               zsal(jfl) = sn(iafloc,ibfloc,icfl) 
     180               zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0 
     181           
     182            ENDIF 
     183 
     184         END DO ! loop on float 
     185 
     186         IF( lk_mpp ) THEN 
     187 
     188            ! Only proc 0 writes all positions 
     189                
     190            !SUM of positions on all procs 
     191            write(narea+200,*)"zlon avt mpp_sum ",zlon 
     192            CALL mpp_sum( zlon, jpnfl )   ! sums over the global domain 
     193            write(narea+200,*)"zlon apr mpp_sum ",zlon 
     194            CALL mpp_sum( zlat, jpnfl )   ! sums over the global domain 
     195            CALL mpp_sum( zdep, jpnfl )   ! sums over the global domain 
     196            CALL mpp_sum( ztem, jpnfl )   ! sums over the global domain 
     197            CALL mpp_sum( zsal, jpnfl )   ! sums over the global domain 
     198            CALL mpp_sum( zrho, jpnfl )   ! sums over the global domain 
     199              
    194200         ENDIF 
    195201 
    196          ! 
    197          WRITE(numflo) flxx,flyy,flzz,nisobfl,ngrpfl,ztemp,zsal, FLOAT(ndastp) 
    198       !! 
    199       !! case when profiles are dumped. In order to save memory, dumps are 
    200       !! done level by level. 
    201       !      IF (mod(kt,nflclean) == 0.) THEN 
    202       !!     IF ( nwflo == nwprofil ) THEN 
    203       !        DO jk = 1,jpk 
    204       !         DO jfl=1,jpnfl 
    205       !         iafl= INT(tpifl(jfl)) 
    206       !         ibfl=INT(tpjfl(jfl)) 
    207       !         iafln=NINT(tpifl(jfl)) 
    208       !         ibfln=NINT(tpjfl(jfl)) 
    209       !# if defined key_mpp_mpi    
    210       !        IF ( (iafl >= (mig(nldi)-jpizoom+1)) .AND. 
    211       !     $       (iafl <= (mig(nlei)-jpizoom+1)) .AND. 
    212       !     $       (ibfl >= (mjg(nldj)-jpjzoom+1)) .AND. 
    213       !     $       (ibfl <= (mjg(nlej)-jpjzoom+1)) ) THEN 
    214       !! 
    215       !! local index 
    216       !! 
    217       !         iafloc=iafln-(mig(1)-jpizoom+1)+1 
    218       !         ibfloc=ibfln-(mjg(1)-jpjzoom+1)+1 
    219       !!         IF (jk == 1 ) THEN 
    220       !!      PRINT *,'<<<>>> ',jfl,narea, iafloc ,ibfloc, iafln, ibfln,adatrj 
    221       !!         ENDIF 
    222       !# else 
    223       !         iafloc=iafln 
    224       !         ibfloc=ibfln 
    225       !# endif 
    226       !         ztemp(jfl)=tn(iafloc,ibfloc,jk) 
    227       !         zsal(jfl)=sn(iaflo!,ibfloc,jk) 
    228       !# if defined key_mpp_mpi    
    229       !        ELSE 
    230       !         ztemp(jfl) = 0. 
    231       !         zsal(jfl) = 0. 
    232       !        ENDIF 
    233       !# endif 
    234       !! ... next float 
    235       !        END DO 
    236       !      IF( lk_mpp )   CALL mpp_sum( ztemp, jpnfl ) 
    237       !      IF( lk_mpp )   CALL mpp_sum( zsal , jpnfl ) 
    238       ! 
    239       !      IF (lwp) THEN  
    240       !         WRITE(numflo) ztemp, zsal 
    241       !      ENDIF 
    242       !! ... next level jk 
    243       !      END DO 
    244       !! ... reset nwflo to 0 for ALL processors, if profile has been written 
    245       !!       nwflo = 0 
    246       !      ENDIF 
    247       !! 
    248       !      CALL flush (numflo) 
    249       !! ... time of dumping floats 
    250       !!      END IF 
    251       ENDIF 
    252        
    253       IF( (MOD(kt,nn_stockfl) == 0) .OR. ( kt == nitend ) ) THEN  
    254          ! Writing the restart file  
    255          IF(lwp) THEN 
    256             WRITE(numout,*) 
    257             WRITE(numout,*) 'flo_wri : write in  restart_float file ' 
    258             WRITE(numout,*) '~~~~~~~    ' 
     202 
     203      !ENDIF  !end of saving variables 
     204 
     205 
     206      !---------------------------------! 
     207      ! WRITE WRITE WRITE WRITE WRITE   ! 
     208      !---------------------------------! 
     209 
     210      !----------------------------------------------------- 
     211      ! II- Write in ascii file 
     212      !----------------------------------------------------- 
     213 
     214      IF( ln_flo_ascii )THEN 
     215 
     216         IF( ( kt == nn_it000 .OR. MOD( kt,nn_writefl)== 0 ) .AND. lwp )THEN 
     217 
     218            !II-2-a Open ascii file 
     219            !---------------------- 
     220            IF( kt == nn_it000 ) THEN 
     221               CALL ctl_opn( numfl, 'trajec_float', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     222               irecflo = NINT( (nitend-nn_it000) / FLOAT(nn_writefl) ) 
     223               WRITE(numfl,*)cexper,no,irecflo,jpnfl,nn_writefl 
     224            ENDIF 
     225 
     226            !III-2-b Write in ascii file 
     227            !----------------------------- 
     228            WRITE(numfl,*) zlon,zlat,zdep,nisobfl,ngrpfl,ztem,zsal, FLOAT(ndastp) 
     229 
     230 
     231            !III-2-c Close netcdf file 
     232            !------------------------- 
     233            IF( kt == nitend )   CLOSE( numfl ) 
     234 
    259235         ENDIF 
    260236 
    261          ! file is opened and closed every time it is used. 
    262  
    263          clname = 'restart.float.' 
    264          ic = 1 
    265          DO jc = 1, 16 
    266             IF( cexper(jc:jc) /= ' ' ) ic = jc 
    267          END DO 
    268          clname = clname(1:14)//cexper(1:ic) 
    269          ic = 1 
    270          DO jc = 1, 48 
    271             IF( clname(jc:jc) /= ' ' ) ic = jc 
    272          END DO 
    273  
    274          CALL ctl_opn( inum, clname, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    275          REWIND inum 
    276          ! 
    277          DO jpn = 1, jpnij 
    278             iproc(jpn) = 0 
    279          END DO 
    280          ! 
    281          IF(lwp) THEN 
    282             REWIND(inum) 
    283             WRITE (inum) tpifl,tpjfl,tpkfl,nisobfl,ngrpfl 
    284             CLOSE (inum)  
     237      !----------------------------------------------------- 
     238      ! III- Write in netcdf file 
     239      !----------------------------------------------------- 
     240 
     241      ELSE 
     242 
     243#if defined key_iomput 
     244         IF(lwp)WRITE(numout,*)"zlon ",zlon ; call FLUSH(numout) 
     245         CALL iom_put( "traj_lon"     , zlon ) 
     246         CALL iom_put( "traj_lat"     , zlat ) 
     247         CALL iom_put( "traj_dep"     , zdep ) 
     248         CALL iom_put( "traj_temp"    , ztem ) 
     249         CALL iom_put( "traj_salt"    , zsal  ) 
     250         CALL iom_put( "traj_dens"    , zrho ) 
     251         CALL iom_put( "traj_group"   , REAL(ngrpfl,wp) ) 
     252#else 
     253 
     254      !III-2 Write with IOIPSL 
     255      !---------------------- 
     256 
     257         IF( ( kt == nn_it000 .OR. MOD( kt,nn_writefl)== 0 ) .AND. lwp )THEN 
     258 
     259 
     260            !III-2-a Open netcdf file 
     261            !----------------------- 
     262            IF( kt==nn_it000 )THEN   ! Create and open 
     263 
     264               CALL dia_nam( clname, nn_writefl, 'trajec_float' ) 
     265               clname=TRIM(clname)//".nc" 
     266 
     267               CALL fliocrfd( clname , (/ 'ntraj' , 't' /), (/ jpnfl , -1  /) , numfl ) 
     268    
     269               CALL fliodefv( numfl, 'traj_lon'    , (/1,2/), v_t=flio_r8, long_name="Longitude"           , units="degrees_east"  ) 
     270               CALL fliodefv( numfl, 'traj_lat'    , (/1,2/), v_t=flio_r8, long_name="Latitude"            , units="degrees_north" ) 
     271               CALL fliodefv( numfl, 'traj_depth'  , (/1,2/), v_t=flio_r8, long_name="Depth"               , units="meters" ) 
     272               CALL fliodefv( numfl, 'time_counter', (/2/)  , v_t=flio_r8, long_name="Time axis"           &  
     273                         & , units="seconds since start of the run " ) 
     274               CALL fliodefv( numfl, 'traj_temp'   , (/1,2/), v_t=flio_r8, long_name="Temperature"         , units="C" ) 
     275               CALL fliodefv( numfl, 'traj_salt'   , (/1,2/), v_t=flio_r8, long_name="Salinity"            , units="PSU" ) 
     276               CALL fliodefv( numfl, 'traj_dens'   , (/1,2/), v_t=flio_r8, long_name="Density"             , units="kg/m3" ) 
     277               CALL fliodefv( numfl, 'traj_group'  , (/1/)  , v_t=flio_r8, long_name="number of the group" , units="no unit" ) 
     278 
     279               CALL flioputv( numfl , 'traj_group' , REAL(ngrpfl,wp) ) 
     280   
     281            ELSE  ! Re-open 
     282        
     283               CALL flioopfd( TRIM(clname), numfl , "WRITE" ) 
     284 
     285            ENDIF 
     286 
     287            !III-2-b Write in  netcdf file 
     288            !----------------------------- 
     289            irec =  INT( (kt-nn_it000+1)/nn_writefl ) +1 
     290            ztime = ( kt-nn_it000 + 1 ) * rdt 
     291 
     292            CALL flioputv( numfl , 'time_counter', ztime , start=(/irec/) ) 
     293 
     294            DO jfl = 1, jpnfl 
     295 
     296               istart = (/jfl,irec/) 
     297               icfl   = INT( tpkfl(jfl) )            ! K-index of the nearest point before 
     298 
     299               CALL flioputv( numfl , 'traj_lon'    , zlon(jfl)        , start=istart ) 
     300               CALL flioputv( numfl , 'traj_lat'    , zlat(jfl)        , start=istart )   
     301               CALL flioputv( numfl , 'traj_depth'  , zdep(jfl)        , start=istart )   
     302               CALL flioputv( numfl , 'traj_temp'   , ztemp(icfl,jfl)  , start=istart )   
     303               CALL flioputv( numfl , 'traj_salt'   , zsal(icfl,jfl)   , start=istart )   
     304               CALL flioputv( numfl , 'traj_dens'   , zrho(icfl,jfl)   , start=istart )   
     305 
     306            ENDDO 
     307 
     308            !III-2-c Close netcdf file 
     309            !------------------------- 
     310            CALL flioclo( numfl ) 
     311 
    285312         ENDIF 
    286          ! 
    287          ! Compute the number of trajectories for each processor 
    288          ! 
    289          IF( lk_mpp ) THEN 
    290             DO jfl = 1, jpnfl 
    291                IF( (INT(tpifl(jfl)) >= (mig(nldi)-jpizoom+1)) .AND.   & 
    292                   &(INT(tpifl(jfl)) <= (mig(nlei)-jpizoom+1)) .AND.   & 
    293                   &(INT(tpjfl(jfl)) >= (mjg(nldj)-jpjzoom+1)) .AND.   & 
    294                   &(INT(tpjfl(jfl)) <= (mjg(nlej)-jpjzoom+1)) ) THEN 
    295                   iproc(narea) = iproc(narea)+1 
    296                ENDIF 
    297             END DO 
    298             CALL mpp_sum( iproc, jpnij ) 
    299             ! 
    300             IF(lwp) THEN  
    301                WRITE(numout,*) 'DATE',adatrj 
    302                DO jpn = 1, jpnij 
    303                   IF( iproc(jpn) /= 0 ) THEN 
    304                      WRITE(numout,*)'PROCESSOR',jpn-1,'compute',iproc(jpn), 'trajectories.' 
    305                   ENDIF 
    306                END DO 
    307             ENDIF 
    308          ENDIF 
    309       ENDIF  
    310  
    311       IF( kt == nitend )   CLOSE( numflo )  
    312       ! 
     313 
     314#endif 
     315      ENDIF ! netcdf writing 
     316    
    313317   END SUBROUTINE flo_wri 
     318 
    314319 
    315320#  else 
     
    321326   END SUBROUTINE flo_wri 
    322327#endif 
    323     
    324    !!====================================================================== 
     328 
     329   !!======================================================================= 
    325330END MODULE flowri 
Note: See TracChangeset for help on using the changeset viewer.