Changeset 2839


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

modified routine for netcdf output

Location:
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM
Files:
1 added
13 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/CONFIG/GYRE/EXP00/namelist

    r2715 r2839  
    750750&namflo       !   float parameters                                      ("key_float") 
    751751!----------------------------------------------------------------------- 
     752   jpnfl      = 1          !  total number of floats during the run 
     753   jpnnewflo  = 0          !  number of floats for the restart 
    752754   ln_rstflo  = .false.    !  float restart (T) or not (F) 
    753755   nn_writefl =      75    !  frequency of writing in float output file  
     
    756758   ln_flork4  = .false.    !  trajectories computed with a 4th order Runge-Kutta (T) 
    757759                           !  or computed with Blanke' scheme (F) 
     760   ln_ariane  = .true.     !  Output with Ariane tool netcdf convention(T) or ascii file (F) 
    758761/ 
    759762!----------------------------------------------------------------------- 
  • branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml

    r2729 r2839  
    204204   <field id="saltot"     description="global mean salinity"                       unit="psu"  /> 
    205205   <field id="fram_trans" description="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" /> 
     206      </group> 
     207 
     208      <!-- variables available with key_float --> 
     209      <group id="floatvar" axis_ref="nfloat" grid_ref="scalarpoint" zoom_ref="1point"> 
     210        <field id="traj_lon"   description="floats longitude"   unit="deg"   /> 
     211        <field id="traj_lat"   description="floats latitude"    unit="deg"   /> 
     212        <field id="traj_dep"   description="floats depth"       unit="m"     /> 
     213        <field id="traj_temp"  description="floats temperature" unit="degC"  /> 
     214        <field id="traj_salt"  description="floats salinity"    unit="psu"   /> 
     215        <field id="traj_dens"  description="floats density"     unit="kg/m3" /> 
     216        <field id="traj_group" description="floats group"       unit="none"  /> 
    206217      </group> 
    207218 
     
    827838   </group> 
    828839 
    829       </group> 
     840        <file id="floats"  description="floats variables"> 
     841           <field ref="traj_lon"   name="floats_longitude"   operation="inst(X)"    /> 
     842           <field ref="traj_lat"   name="floats_latitude"    operation="inst(X)"    /> 
     843           <field ref="traj_dep"   name="floats_depth"       operation="inst(X)"    /> 
     844           <field ref="traj_temp"  name="floats_temperature" operation="inst(X)"    /> 
     845           <field ref="traj_salt"  name="floats_salinity"    operation="inst(X)"    /> 
     846           <field ref="traj_dens"  name="floats_density"     operation="inst(X)"    /> 
     847           <field ref="traj_group" name="floats_group"       operation="inst(X)"    /> 
     848        </file> 
    830849       
    831850      <group id="3d" output_freq="259200" output_level="10" enabled=".TRUE.">                      <!-- 3d files --> 
     
    948967     
    949968    <axis_definition>   
    950       <axis id="deptht" description="Vertical T levels" unit="m" positive=".false." /> 
    951       <axis id="depthu" description="Vertical U levels" unit="m" positive=".false." /> 
    952       <axis id="depthv" description="Vertical V levels" unit="m" positive=".false." /> 
    953       <axis id="depthw" description="Vertical W levels" unit="m" positive=".false." /> 
     969      <axis id="deptht" description="Vertical T levels" unit="m"    positive=".false." /> 
     970      <axis id="depthu" description="Vertical U levels" unit="m"    positive=".false." /> 
     971      <axis id="depthv" description="Vertical V levels" unit="m"    positive=".false." /> 
     972      <axis id="depthw" description="Vertical W levels" unit="m"    positive=".false." /> 
     973      <axis id="nfloat" description="number of float"   unit="none" positive=".false."  /> 
    954974      <axis id="none" description="axe non defini" unit="none" size="1" /> 
    955975    </axis_definition>  
  • branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist

    r2715 r2839  
    750750&namflo       !   float parameters                                      ("key_float") 
    751751!----------------------------------------------------------------------- 
     752   jpnfl      = 1          !  total number of floats during the run 
     753   jpnnewflo  = 0          !  number of floats for the restart 
    752754   ln_rstflo  = .false.    !  float restart (T) or not (F) 
    753755   nn_writefl =      75    !  frequency of writing in float output file  
     
    756758   ln_flork4  = .false.    !  trajectories computed with a 4th order Runge-Kutta (T) 
    757759                           !  or computed with Blanke' scheme (F) 
     760   ln_ariane  = .true.     !  Output with Ariane tool netcdf convention(T) or ascii file (F) 
    758761/ 
    759762!----------------------------------------------------------------------- 
  • branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist

    r2715 r2839  
    764764&namflo       !   float parameters                                      ("key_float") 
    765765!----------------------------------------------------------------------- 
     766   jpnfl      = 1          !  total number of floats during the run 
     767   jpnnewflo  = 0          !  number of floats for the restart 
    766768   ln_rstflo  = .false.    !  float restart (T) or not (F) 
    767769   nn_writefl =      75    !  frequency of writing in float output file  
     
    771773                           !  or computed with Blanke' scheme (F) 
    772774                           !  or computed with Blanke' scheme (F) 
     775   ln_ariane  = .true.     !  Output with Ariane tool netcdf convention(T) or ascii file (F) 
    773776/ 
    774777!----------------------------------------------------------------------- 
  • branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/CONFIG/POMME/EXP00/namelist

    r2650 r2839  
    755755&namflo       !   float parameters                                      ("key_float") 
    756756!----------------------------------------------------------------------- 
     757   jpnfl      = 1          !  total number of floats during the run 
     758   jpnnewflo  = 0          !  number of floats for the restart 
    757759   ln_rstflo  = .false.    !  float restart (T) or not (F) 
    758760   nn_writefl =      75    !  frequency of writing in float output file  
     
    761763   ln_flork4  = .false.    !  trajectories computed with a 4th order Runge-Kutta (T) 
    762764                           !  or computed with Blanke' scheme (F) 
     765   ln_ariane  = .true.     !  Output with Ariane tool netcdf convention(T) or ascii file (F) 
    763766/ 
    764767!----------------------------------------------------------------------- 
  • branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90

    r2528 r2839  
    5252      !! 
    5353      INTEGER ::  jfl, jind           ! dummy loop indices 
    54       REAL(wp), DIMENSION(jpnfl)   ::   zgifl , zgjfl , zgkfl    ! index RK  positions 
    55       REAL(wp), DIMENSION(jpnfl)   ::   zufl  , zvfl  , zwfl     ! interpolated velocity at the float position  
    56       REAL(wp), DIMENSION(jpnfl,4) ::   zrkxfl, zrkyfl, zrkzfl   ! RK coefficients 
     54      REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   zgifl , zgjfl , zgkfl    ! index RK  positions 
     55      REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   zufl  , zvfl  , zwfl     ! interpolated velocity at the float position  
     56      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zrkxfl, zrkyfl, zrkzfl   ! RK coefficients 
    5757      !!--------------------------------------------------------------------- 
     58 
     59      ALLOCATE (  zgifl(jpnfl)  ,  zgjfl(jpnfl)  ,  zgkfl(jpnfl)   ) 
     60      ALLOCATE (   zufl(jpnfl)  ,   zvfl(jpnfl)  ,   zwfl(jpnfl)   )          
     61      ALLOCATE ( zrkxfl(jpnfl,4), zrkyfl(jpnfl,4), zrkzfl(jpnfl,4) ) 
    5862     
    5963      IF( kt == nit000 ) THEN 
     
    145149         END DO 
    146150      END DO 
     151      ! 
     152      DEALLOCATE( zgifl  , zgjfl  , zgkfl  ) 
     153      DEALLOCATE( zufl   , zvfl   , zwfl   ) 
     154      DEALLOCATE( zrkxfl , zrkyfl , zrkzfl ) 
    147155      ! 
    148156   END SUBROUTINE flo_4rk 
  • branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90

    r2715 r2839  
    2424   !! float parameters 
    2525   !! ---------------- 
    26    INTEGER, PUBLIC, PARAMETER ::   jpnfl     = 23                  !: total number of floats during the run 
    27    INTEGER, PUBLIC, PARAMETER ::   jpnnewflo =  0                  !: number of floats added in a new run 
    28    INTEGER, PUBLIC, PARAMETER ::   jpnrstflo = jpnfl - jpnnewflo   !: number of floats for the restart 
     26   INTEGER, PUBLIC ::   jpnfl       !: total number of floats during the run 
     27   INTEGER, PUBLIC ::   jpnnewflo   !: number of floats added in a new run 
     28   INTEGER, PUBLIC ::   jpnrstflo   !: number of floats for the restart 
    2929 
    3030   !! float variables 
    3131   !! --------------- 
    32    INTEGER , PUBLIC, DIMENSION(jpnfl) ::   nisobfl   !: =0 for a isobar float , =1 for a float following the w velocity 
    33    INTEGER , PUBLIC, DIMENSION(jpnfl) ::   ngrpfl    !: number to identify searcher group 
     32   INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) ::   nisobfl   !: =0 for a isobar float , =1 for a float following the w velocity 
     33   INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) ::   ngrpfl    !: number to identify searcher group 
     34   INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) ::   nfloat    !: number to identify searcher group 
    3435 
    35    REAL(wp), PUBLIC, DIMENSION(jpnfl) ::   flxx , flyy , flzz    !: long, lat, depth of float (decimal degree, m >0) 
    36    REAL(wp), PUBLIC, DIMENSION(jpnfl) ::   tpifl, tpjfl, tpkfl   !: (i,j,k) indices of float position 
     36   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   flxx , flyy , flzz    !: long, lat, depth of float (decimal degree, m >0) 
     37   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   tpifl, tpjfl, tpkfl   !: (i,j,k) indices of float position 
    3738 
    3839   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wb   !: vertical velocity at previous time step (m s-1). 
    3940    
    40    !                                            !!! * namelist namflo : langrangian floats * 
    41    LOGICAL, PUBLIC  ::   ln_rstflo  = .FALSE.    !: T/F float restart  
    42    LOGICAL, PUBLIC  ::   ln_argo    = .FALSE.    !: T/F argo type floats 
    43    LOGICAL, PUBLIC  ::   ln_flork4  = .FALSE.    !: T/F 4th order Runge-Kutta 
    44    INTEGER, PUBLIC  ::   nn_writefl = 150        !: frequency of float output file  
    45    INTEGER, PUBLIC  ::   nn_stockfl = 450        !: frequency of float restart file 
     41   !                                                 !!! * namelist namflo : langrangian floats * 
     42   LOGICAL, PUBLIC  ::   ln_rstflo      = .FALSE.    !: T/F float restart  
     43   LOGICAL, PUBLIC  ::   ln_argo        = .FALSE.    !: T/F argo type floats 
     44   LOGICAL, PUBLIC  ::   ln_flork4      = .FALSE.    !: T/F 4th order Runge-Kutta 
     45   LOGICAL, PUBLIC  ::   ln_ariane      = .FALSE.    !: handle ariane input/output convention 
     46   LOGICAL, PUBLIC  ::   ln_flo_ascii   = .FALSE.    !: write in ascii (T) or in Netcdf (F) 
     47 
     48   INTEGER, PUBLIC  ::   nn_writefl     = 150        !: frequency of float output file  
     49   INTEGER, PUBLIC  ::   nn_stockfl     = 450        !: frequency of float restart file 
    4650 
    4751   !!---------------------------------------------------------------------- 
     
    5660      !!                 ***  FUNCTION flo_oce_alloc  *** 
    5761      !!---------------------------------------------------------------------- 
    58       ALLOCATE( wb(jpi,jpj,jpk)   , STAT=flo_oce_alloc ) 
     62      ALLOCATE( wb(jpi,jpj,jpk) , nfloat(jpnfl) , nisobfl(jpnfl) , ngrpfl(jpnfl) , & 
     63                flxx(jpnfl)     , flyy(jpnfl)   , flzz(jpnfl)    ,                 &  
     64                tpifl(jpnfl)    , tpjfl(jpnfl)  , tpkfl(jpnfl)   , STAT=flo_oce_alloc ) 
    5965      ! 
    6066      IF( lk_mpp             )   CALL mpp_sum ( flo_oce_alloc ) 
  • branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90

    r2715 r2839  
    1919   USE flodom          ! initialisation Module  
    2020   USE flowri          ! float output                     (flo_wri routine) 
     21   USE florst          ! float restart                    (flo_rst routine) 
    2122   USE flo4rk          ! Trajectories, Runge Kutta scheme (flo_4rk routine) 
    2223   USE floblk          ! Trajectories, Blanke scheme      (flo_blk routine) 
     
    5657      IF( lk_mpp )   CALL mppsync   ! synchronization of all the processor 
    5758      ! 
    58       IF( kt == nit000 .OR. MOD( kt, nn_writefl ) == 0 )   CALL flo_wri( kt )      ! trajectories file  
    59       IF( kt == nitend .OR. MOD( kt, nn_stockfl ) == 0 )   CALL flo_wri( kt )      ! restart file  
     59      !IF( kt == nit000 .OR. MOD( kt, nn_writefl ) == 0 )   CALL flo_wri( kt )      ! trajectories file  
     60      CALL flo_wri( kt )      ! trajectories file  
     61      !??IF( kt == nitend .OR. MOD( kt, nn_stockfl ) == 0 )   CALL flo_wri( kt )      ! restart file  
    6062      ! 
    6163      wb(:,:,:) = wn(:,:,:)         ! Save the old vertical velocity field 
     
    7072      !! ** Purpose :   Read the namelist of floats 
    7173      !!---------------------------------------------------------------------- 
    72       NAMELIST/namflo/ ln_rstflo, nn_writefl, nn_stockfl, ln_argo, ln_flork4  
     74      INTEGER :: jfl 
     75      ! 
     76      NAMELIST/namflo/ jpnfl, jpnnewflo, ln_rstflo, nn_writefl, nn_stockfl, ln_argo, ln_flork4, ln_ariane, ln_flo_ascii 
    7377      !!--------------------------------------------------------------------- 
    7478      ! 
     
    8387         WRITE(numout,*) 
    8488         WRITE(numout,*) '         Namelist floats :' 
    85          WRITE(numout,*) '            restart                          ln_rstflo  = ', ln_rstflo 
    86          WRITE(numout,*) '            frequency of float output file   nn_writefl = ', nn_writefl 
    87          WRITE(numout,*) '            frequency of float restart file  nn_stockfl = ', nn_stockfl 
    88          WRITE(numout,*) '            Argo type floats                 ln_argo    = ', ln_argo 
    89          WRITE(numout,*) '            Computation of T trajectories    ln_flork4  = ', ln_flork4 
     89         WRITE(numout,*) '            number of floats                      jpnfl        = ', jpnfl 
     90         WRITE(numout,*) '            number of new floats                  jpnflnewflo  = ', jpnnewflo 
     91         WRITE(numout,*) '            restart                               ln_rstflo    = ', ln_rstflo 
     92         WRITE(numout,*) '            frequency of float output file        nn_writefl   = ', nn_writefl 
     93         WRITE(numout,*) '            frequency of float restart file       nn_stockfl   = ', nn_stockfl 
     94         WRITE(numout,*) '            Argo type floats                      ln_argo      = ', ln_argo 
     95         WRITE(numout,*) '            Computation of T trajectories         ln_flork4    = ', ln_flork4 
     96         WRITE(numout,*) '            Use of ariane convention              ln_ariane    = ', ln_ariane 
     97         WRITE(numout,*) '            ascii output (T) or netcdf output (F) ln_flo_ascii = ', ln_flo_ascii 
     98 
    9099      ENDIF 
    91100      ! 
     
    95104      !                             ! allocate flowri arrays 
    96105      IF( flo_wri_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'flo_wri : unable to allocate arrays' ) 
     106      ! 
     107      !memory allocation  
     108      jpnrstflo = jpnfl-jpnnewflo 
     109 
     110      !vertical axe for netcdf IOM ouput 
     111      DO jfl=1,jpnfl ; nfloat(jfl)=jfl ; ENDDO 
     112 
    97113      ! 
    98114      CALL flo_dom                  ! compute/read initial position of floats 
  • branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90

    r2528 r2839  
    4343      !!               the longitude (degree) and the depth (m). 
    4444      !!----------------------------------------------------------------------       
    45       LOGICAL  ::   llinmesh 
    46       INTEGER  ::   ji, jj, jk   ! DO loop index on 3 directions 
    47       INTEGER  ::   jfl, jfl1    ! number of floats    
    48       INTEGER  ::   inum         ! logical unit for file read 
     45      CHARACTER (len=21) ::  clname        ! floats initialisation filename 
     46      LOGICAL            ::   llinmesh 
     47      INTEGER            ::   ji, jj, jk   ! DO loop index on 3 directions 
     48      INTEGER            ::   jfl, jfl1    ! number of floats    
     49      INTEGER            ::   inum         ! logical unit for file read 
     50      INTEGER            ::   jtrash       ! trash var for reading   
     51      INTEGER            ::   ierr 
    4952      INTEGER, DIMENSION(jpnfl) ::   iimfl, ijmfl, ikmfl       ! index mesh of floats 
    5053      INTEGER, DIMENSION(jpnfl) ::   idomfl,  ivtest, ihtest   !   -             - 
     
    6669 
    6770         ! read of the restart file 
    68          READ(inum) ( tpifl  (jfl), jfl=1, jpnrstflo),   &  
     71         READ(inum,*)  ( tpifl  (jfl), jfl=1, jpnrstflo),   &  
    6972                        ( tpjfl  (jfl), jfl=1, jpnrstflo),   & 
    7073                        ( tpkfl  (jfl), jfl=1, jpnrstflo),   & 
     
    208211         ENDIF 
    209212      ELSE 
    210          IF(lwp) WRITE(numout,*) '                     init_float read ' 
     213 
     214         IF( ln_ariane )THEN 
     215 
     216            IF(lwp) WRITE(numout,*) '                     init_float read with ariane convention (mesh indexes)' 
     217 
     218            ! First initialisation of floats with ariane convention 
     219            !  
     220            ! The indexes are read directly from file (warning ariane 
     221            ! convention, are refered to  
     222            ! U,V,W grids - and not T-)  
     223            ! The isobar advection is managed with the sign of tpkfl ( >0 -> 3D 
     224            ! advection, <0 -> 2D)  
     225            ! Some variables are not read, as - gl         : time index; 4th 
     226            ! column         
     227            !                                 - transport  : transport ; 5th 
     228            !                                 column 
     229            ! and paste in the jtrash var 
     230            ! At the end, ones need to replace the indexes on T grid 
     231            ! RMQ : there is no float groups identification ! 
     232  
     233            clname='init_float_ariane' 
     234 
     235            nisobfl = 1 ! we assume that by default we want 3D advection 
     236             
     237            ! we check that the number of floats in the init_file are consistant 
     238            ! with the namelist 
     239            IF( lwp ) THEN  
     240               jfl1=0 
     241               OPEN( unit=inum, file=clname,status='old',access='sequential',form='formatted') 
     242               DO WHILE (ierr .GE. 0) 
     243                 jfl1=jfl1+1 
     244                 READ (inum,*, iostat=ierr) 
     245               END DO 
     246               CLOSE(inum) 
     247               IF( (jfl1-1) .NE. jpnfl )THEN 
     248                  WRITE (numout,*) ' STOP the number of floats in' ,clname,'  = ',jfl1 
     249                  WRITE (numout,*) '  is not equal to jfl= ',jpnfl  
     250                  STOP 
     251               ENDIF  
     252            ENDIF  
     253 
     254            ! we get the init values  
     255            CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL',   & 
     256               &         1, numout, .TRUE., 1 ) 
     257            DO jfl = 1, jpnfl 
     258              READ(inum,*) tpifl(jfl),tpjfl(jfl),tpkfl(jfl),jtrash, jtrash 
     259              if(lwp)write(numout,*)"read : ",tpifl(jfl),tpjfl(jfl),tpkfl(jfl),jtrash, jtrash ; call flush(numout) 
     260  
     261              IF ( tpkfl(jfl) .LT. 0. ) nisobfl(jfl) = 0 !set the 2D advection according to init_float 
     262              ngrpfl(jfl)=jfl 
     263            END DO 
     264 
     265            ! conversion from ariane index to T grid index 
     266            tpkfl = abs(tpkfl)-0.5 ! reversed vertical axis 
     267            tpifl = tpifl+0.5  
     268            tpjfl = tpjfl+0.5 
     269 
     270            ! verif of non land point initialisation : no need if correct init 
     271             
     272         ELSE  
     273            IF(lwp) WRITE(numout,*) '                     init_float read ' 
    211274          
    212          ! First initialisation of floats 
    213          ! the initials positions of floats are written in a file 
    214          ! with a variable to know if it is a isobar float a number  
    215          ! to identified who want the trajectories of this float and  
    216          ! an index for the number of the float          
    217          ! open the init file  
    218          CALL ctl_opn( inum, 'init_float', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
    219          READ(inum) (flxx(jfl)   , jfl=1, jpnfl),   & 
    220                     (flyy(jfl)   , jfl=1, jpnfl),   & 
    221                     (flzz(jfl)   , jfl=1, jpnfl),   & 
    222                     (nisobfl(jfl), jfl=1, jpnfl),   & 
    223                     (ngrpfl(jfl) , jfl=1, jpnfl) 
    224          CLOSE(inum) 
    225              
    226          ! Test to find the grid point coordonate with the geographical position          
    227          DO jfl = 1, jpnfl 
    228             ihtest(jfl) = 0 
    229             ivtest(jfl) = 0 
    230             ikmfl(jfl) = 0 
     275            ! First initialisation of floats 
     276            ! the initials positions of floats are written in a file 
     277            ! with a variable to know if it is a isobar float a number  
     278            ! to identified who want the trajectories of this float and  
     279            ! an index for the number of the float          
     280            ! open the init file  
     281            CALL ctl_opn( inum, 'init_float', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
     282            READ(inum,*) (flxx(jfl)   , jfl=1, jpnfl),   & 
     283                         (flyy(jfl)   , jfl=1, jpnfl),   & 
     284                         (flzz(jfl)   , jfl=1, jpnfl),   & 
     285                         (nisobfl(jfl), jfl=1, jpnfl),   & 
     286                         (ngrpfl(jfl) , jfl=1, jpnfl) 
     287            CLOSE(inum) 
     288             
     289            ! Test to find the grid point coordonate with the geographical position          
     290            DO jfl = 1, jpnfl 
     291              ihtest(jfl) = 0 
     292              ivtest(jfl) = 0 
     293              ikmfl(jfl) = 0 
    231294# if   defined key_mpp_mpi 
    232             DO ji = MAX(nldi,2), nlei 
    233                DO jj = MAX(nldj,2), nlej   ! NO vector opt. 
    234 # else 
    235             DO ji = 2, jpi 
    236                DO jj = 2, jpj   ! NO vector opt. 
     295               DO ji = MAX(nldi,2), nlei 
     296                  DO jj = MAX(nldj,2), nlej   ! NO vector opt. 
     297# else  
     298               DO ji = 2, jpi 
     299                  DO jj = 2, jpj   ! NO vector opt. 
    237300# endif                   
    238                   ! for each float we find the indexes of the mesh  
     301                     ! for each float we find the indexes of the mesh  
    239302                   
    240                   CALL findmesh(glamf(ji-1,jj-1),gphif(ji-1,jj-1),   & 
    241                                 glamf(ji-1,jj  ),gphif(ji-1,jj  ),   & 
    242                                 glamf(ji  ,jj  ),gphif(ji  ,jj  ),   & 
    243                                 glamf(ji  ,jj-1),gphif(ji  ,jj-1),   & 
    244                                 flxx(jfl)       ,flyy(jfl)       ,   & 
    245                                 glamt(ji  ,jj  ),gphit(ji  ,jj  ), llinmesh) 
    246                   IF(llinmesh) THEN 
    247                      iimfl(jfl)  = ji 
    248                      ijmfl(jfl)  = jj 
    249                      ihtest(jfl) = ihtest(jfl)+1 
    250                      DO jk = 1, jpk-1 
    251                         IF( (fsdepw(ji,jj,jk) <= flzz(jfl)) .AND. (fsdepw(ji,jj,jk+1) >  flzz(jfl)) ) THEN 
    252                            ikmfl(jfl)  = jk 
    253                            ivtest(jfl) = ivtest(jfl) + 1 
    254                         ENDIF 
    255                      END DO 
    256                   ENDIF 
     303                     CALL findmesh(glamf(ji-1,jj-1),gphif(ji-1,jj-1),   & 
     304                                   glamf(ji-1,jj  ),gphif(ji-1,jj  ),   & 
     305                                   glamf(ji  ,jj  ),gphif(ji  ,jj  ),   & 
     306                                   glamf(ji  ,jj-1),gphif(ji  ,jj-1),   & 
     307                                   flxx(jfl)       ,flyy(jfl)       ,   & 
     308                                   glamt(ji  ,jj  ),gphit(ji  ,jj  ), llinmesh) 
     309                     IF(llinmesh) THEN 
     310                        iimfl(jfl)  = ji 
     311                        ijmfl(jfl)  = jj 
     312                        ihtest(jfl) = ihtest(jfl)+1 
     313                        DO jk = 1, jpk-1 
     314                           IF( (fsdepw(ji,jj,jk) <= flzz(jfl)) .AND. (fsdepw(ji,jj,jk+1) >  flzz(jfl)) ) THEN 
     315                              ikmfl(jfl)  = jk 
     316                              ivtest(jfl) = ivtest(jfl) + 1 
     317                           ENDIF 
     318                        END DO 
     319                     ENDIF 
     320                  END DO 
    257321               END DO 
    258             END DO 
    259              
    260             ! If the float is in a mesh computed by an other processor we put iimfl=ijmfl=-1             
    261             IF( ihtest(jfl) == 0 ) THEN 
    262                iimfl(jfl) = -1 
    263                ijmfl(jfl) = -1 
    264             ENDIF 
    265          END DO 
     322             
     323               ! If the float is in a mesh computed by an other processor we put iimfl=ijmfl=-1             
     324               IF( ihtest(jfl) == 0 ) THEN 
     325                  iimfl(jfl) = -1 
     326                  ijmfl(jfl) = -1 
     327               ENDIF 
     328            END DO 
    266329          
    267          ! A zero in the sum of the arrays "ihtest" and "ivtest"           
    268          IF( lk_mpp )   CALL mpp_sum(ihtest,jpnfl)   ! sums over the global domain 
    269          IF( lk_mpp )   CALL mpp_sum(ivtest,jpnfl) 
    270  
    271          DO jfl = 1, jpnfl 
    272             IF( (ihtest(jfl) > 1 ) .OR. ( ivtest(jfl) > 1 )) THEN 
    273                IF(lwp) WRITE(numout,*) 'THE FLOAT',jfl,' IS NOT IN ONLY ONE MESH' 
    274             ENDIF 
    275             IF( ihtest(jfl) == 0 ) THEN  
    276                IF(lwp) WRITE(numout,*)'THE FLOAT',jfl,' IS IN NO MESH' 
    277             ENDIF 
    278          END DO 
     330            ! A zero in the sum of the arrays "ihtest" and "ivtest"           
     331            IF( lk_mpp )   CALL mpp_sum(ihtest,jpnfl)   ! sums over the global domain 
     332            IF( lk_mpp )   CALL mpp_sum(ivtest,jpnfl) 
     333 
     334            DO jfl = 1, jpnfl 
     335               IF( (ihtest(jfl) > 1 ) .OR. ( ivtest(jfl) > 1 )) THEN 
     336                  IF(lwp) WRITE(numout,*) 'THE FLOAT',jfl,' IS NOT IN ONLY ONE MESH' 
     337               ENDIF 
     338               IF( ihtest(jfl) == 0 ) THEN  
     339                  IF(lwp) WRITE(numout,*)'THE FLOAT',jfl,' IS IN NO MESH' 
     340               ENDIF 
     341            END DO 
    279342         
    280          ! We compute the distance between the float and the face of  the mesh          
    281          DO jfl = 1, jpnfl 
    282             ! Made only if the float is in the domain of the processor 
    283             IF( (iimfl(jfl) >= 0 ) .AND. ( ijmfl(jfl) >= 0 ) ) THEN 
    284                 
    285                ! TEST TO KNOW IF THE FLOAT IS NOT INITIALISED IN THE COAST 
    286                 
    287                idomfl(jfl) = 0 
    288                IF( tmask(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) == 0. ) idomfl(jfl)=1 
    289                 
    290                ! Computation of the distance between the float 
    291                ! and the faces of the mesh 
    292                !            zdxab 
    293                !             . 
    294                !        B----.---------C 
    295                !        |    .         | 
    296                !        |<------>flo   | 
    297                !        |        ^     | 
    298                !        |        |.....|....zdyad 
    299                !        |        |     | 
    300                !        A--------|-----D 
    301                 
    302                zdxab = dstnce(flxx(jfl),flyy(jfl),glamf(iimfl(jfl)-1,ijmfl(jfl)-1),flyy(jfl))                 
    303                zdyad = dstnce(flxx(jfl),flyy(jfl),flxx(jfl),gphif(iimfl(jfl)-1,ijmfl(jfl)-1)) 
    304                 
    305                ! Translation of this distances (in meter) in indexes 
    306                 
    307                tpifl(jfl) = (iimfl(jfl)-0.5)+zdxab/ e1u(iimfl(jfl)-1,ijmfl(jfl))+(mig(1)-jpizoom) 
    308                tpjfl(jfl) = (ijmfl(jfl)-0.5)+zdyad/ e2v(iimfl(jfl),ijmfl(jfl)-1)+(mjg(1)-jpjzoom) 
    309                tpkfl(jfl) = (fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl))*(ikmfl(jfl))                     & 
    310                           / (fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)))   & 
    311                           + (flzz(jfl) - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)))*(ikmfl(jfl)+1)                     & 
    312                           / (fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl))) 
    313             ELSE 
    314                tpifl (jfl) = 0.e0 
    315                tpjfl (jfl) = 0.e0 
    316                tpkfl (jfl) = 0.e0 
    317                idomfl(jfl) = 0 
    318             ENDIF 
    319          END DO 
     343            ! We compute the distance between the float and the face of  the mesh          
     344            DO jfl = 1, jpnfl 
     345               ! Made only if the float is in the domain of the processor 
     346               IF( (iimfl(jfl) >= 0 ) .AND. ( ijmfl(jfl) >= 0 ) ) THEN 
     347                
     348                  ! TEST TO KNOW IF THE FLOAT IS NOT INITIALISED IN THE COAST 
     349                
     350                  idomfl(jfl) = 0 
     351                  IF( tmask(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) == 0. ) idomfl(jfl)=1 
     352                
     353                  ! Computation of the distance between the float 
     354                  ! and the faces of the mesh 
     355                  !            zdxab 
     356                  !             . 
     357                  !        B----.---------C 
     358                  !        |    .         | 
     359                  !        |<------>flo   | 
     360                  !        |        ^     | 
     361                  !        |        |.....|....zdyad 
     362                  !        |        |     | 
     363                  !        A--------|-----D 
     364                
     365                  zdxab = dstnce(flxx(jfl),flyy(jfl),glamf(iimfl(jfl)-1,ijmfl(jfl)-1),flyy(jfl))                 
     366                  zdyad = dstnce(flxx(jfl),flyy(jfl),flxx(jfl),gphif(iimfl(jfl)-1,ijmfl(jfl)-1)) 
     367                
     368                  ! Translation of this distances (in meter) in indexes 
     369                
     370                  tpifl(jfl) = (iimfl(jfl)-0.5)+zdxab/ e1u(iimfl(jfl)-1,ijmfl(jfl))+(mig(1)-jpizoom) 
     371                  tpjfl(jfl) = (ijmfl(jfl)-0.5)+zdyad/ e2v(iimfl(jfl),ijmfl(jfl)-1)+(mjg(1)-jpjzoom) 
     372                  tpkfl(jfl) = (fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl))*(ikmfl(jfl))                     & 
     373                             / (fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)))   & 
     374                             + (flzz(jfl) - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)))*(ikmfl(jfl)+1)                     & 
     375                             / (fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl))) 
     376               ELSE 
     377                  tpifl (jfl) = 0.e0 
     378                  tpjfl (jfl) = 0.e0 
     379                  tpkfl (jfl) = 0.e0 
     380                  idomfl(jfl) = 0 
     381               ENDIF 
     382            END DO 
    320383          
    321          ! The sum of all the arrays tpifl, tpjfl, tpkfl give 3 arrays with the positions of all the floats.  
    322          IF( lk_mpp )   CALL mpp_sum( tpifl , jpnfl )   ! sums over the global domain 
    323          IF( lk_mpp )   CALL mpp_sum( tpjfl , jpnfl ) 
    324          IF( lk_mpp )   CALL mpp_sum( tpkfl , jpnfl ) 
    325          IF( lk_mpp )   CALL mpp_sum( idomfl, jpnfl ) 
     384            ! The sum of all the arrays tpifl, tpjfl, tpkfl give 3 arrays with the positions of all the floats.  
     385            IF( lk_mpp )   CALL mpp_sum( tpifl , jpnfl )   ! sums over the global domain 
     386            IF( lk_mpp )   CALL mpp_sum( tpjfl , jpnfl ) 
     387            IF( lk_mpp )   CALL mpp_sum( tpkfl , jpnfl ) 
     388            IF( lk_mpp )   CALL mpp_sum( idomfl, jpnfl ) 
     389         ENDIF 
     390 
    326391      ENDIF 
    327392             
  • 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 
  • branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r2715 r2839  
    111111   INTEGER ::   numevo_ice =   -1      !: logical unit for ice variables (temp. evolution) 
    112112   INTEGER ::   numsol     =   -1      !: logical unit for solver statistics 
     113   INTEGER ::   numfl      =   -1      !: logical unit for floats ascii output 
    113114 
    114115   !!---------------------------------------------------------------------- 
  • branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r2715 r2839  
    1919   !!-------------------------------------------------------------------- 
    2020   USE dom_oce         ! ocean space and time domain 
     21   USE flo_oce         ! floats module declarations 
    2122   USE lbclnk          ! lateal boundary condition / mpp exchanges 
    2223   USE iom_def         ! iom variables definitions 
     
    4849   PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 
    4950   PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d 
    50    PRIVATE iom_p2d, iom_p3d 
     51   PRIVATE iom_p1d, iom_p2d, iom_p3d 
    5152#if defined key_iomput 
    5253   PRIVATE set_grid 
     
    6364   END INTERFACE 
    6465  INTERFACE iom_put 
    65      MODULE PROCEDURE iom_p0d, iom_p2d, iom_p3d 
     66     MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d 
    6667  END INTERFACE 
    6768#if defined key_iomput 
     
    115116      CALL event__set_vert_axis( "depthv", gdept_0 ) 
    116117      CALL event__set_vert_axis( "depthw", gdepw_0 ) 
     118#if defined key_floats 
     119      CALL event__set_vert_axis( "nfloat", REAL(nfloat,wp)  ) 
     120#endif 
    117121       
    118122      ! automatic definitions of some of the xml attributs 
     
    961965#endif 
    962966   END SUBROUTINE iom_p0d 
     967 
     968   SUBROUTINE iom_p1d( cdname, pfield1d ) 
     969      CHARACTER(LEN=*)          , INTENT(in) ::   cdname 
     970      REAL(wp),     DIMENSION(:), INTENT(in) ::   pfield1d 
     971      INTEGER :: jpn 
     972#if defined key_iomput 
     973      CALL event__write_field3D( cdname, RESHAPE( (/pfield1d/), (/1,1,jpn/) ) ) 
     974#else 
     975      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings 
     976#endif 
     977   END SUBROUTINE iom_p1d 
    963978 
    964979   SUBROUTINE iom_p2d( cdname, pfield2d ) 
  • branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r2715 r2839  
    341341#endif 
    342342      !                                     ! Diagnostics 
     343      IF( lk_floats     )   CALL     flo_init   ! drifting Floats 
    343344                            CALL     iom_init   ! iom_put initialization 
    344       IF( lk_floats     )   CALL     flo_init   ! drifting Floats 
    345345      IF( lk_diaar5     )   CALL dia_ar5_init   ! ar5 diag 
    346346                            CALL dia_ptr_init   ! Poleward TRansports initialization 
Note: See TracChangeset for help on using the changeset viewer.