Changeset 2843


Ignore:
Timestamp:
2011-09-19T18:32:43+02:00 (9 years ago)
Author:
cbricaud
Message:

comestic changes for flodom.F90, add call to flo_rst in floats.F90, minor correction in flo_rst

Location:
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO
Files:
3 edited

Legend:

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

    r2841 r2843  
    5757      IF( lk_mpp )   CALL mppsync   ! synchronization of all the processor 
    5858      ! 
    59       CALL flo_wri( kt )      ! trajectories file  
     59      CALL flo_wri( kt )      ! trajectories ouput  
     60      ! 
     61      CALL flo_rst( kt )      ! trajectories restart 
    6062      ! 
    6163      wb(:,:,:) = wn(:,:,:)         ! Save the old vertical velocity field 
  • branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90

    r2839 r2843  
    44   !! Ocean floats :   domain 
    55   !!====================================================================== 
    6    !! History :  OPA  ! 1998-07 (Y.Drillet, CLIPPER)  Original code 
     6   !! History :  OPA          ! 1998-07 (Y.Drillet, CLIPPER)  Original code 
     7   !!            NEMO_3.3.1   ! 2011-09 (C.Bricaud,S.Law-Chune Mercator-Ocean):  
     8                              ! add Ariane convention, Comsecitc changes 
    79   !!---------------------------------------------------------------------- 
    810#if   defined key_floats   ||   defined key_esopa 
     
    1012   !!   'key_floats'                                     float trajectories 
    1113   !!---------------------------------------------------------------------- 
    12    !!   flo_dom        : initialization of floats 
    13    !!   findmesh       : compute index of position  
    14    !!   dstnce         : compute distance between face mesh and floats  
     14   !!   flo_dom               : initialization of floats 
     15   !!   add_new_floats        : add new floats (long/lat/depth) 
     16   !!   add_new_ariane_floats : add new floats with araine convention (i/j/k) 
     17   !!   findmesh              : compute index of position  
     18   !!   dstnce                : compute distance between face mesh and floats  
    1519   !!---------------------------------------------------------------------- 
    1620   USE oce             ! ocean dynamics and tracers 
     
    2529   PUBLIC   flo_dom    ! routine called by floats.F90 
    2630 
     31   CHARACTER (len=21) ::  clname1 = 'init_float'              ! floats initialisation filename 
     32   CHARACTER (len=21) ::  clname2 = 'init_float_ariane'       ! ariane floats initialisation filename 
     33 
    2734   !! * Substitutions 
    2835#  include "domzgr_substitute.h90" 
     
    4350      !!               the longitude (degree) and the depth (m). 
    4451      !!----------------------------------------------------------------------       
    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 
    52       INTEGER, DIMENSION(jpnfl) ::   iimfl, ijmfl, ikmfl       ! index mesh of floats 
    53       INTEGER, DIMENSION(jpnfl) ::   idomfl,  ivtest, ihtest   !   -             - 
    54       REAL(wp) ::   zdxab, zdyad 
    55       REAL(wp), DIMENSION(jpnnewflo+1)  :: zgifl, zgjfl,  zgkfl 
     52      INTEGER            ::   jfl    ! dummy loop   
     53      INTEGER            ::   inum   ! logical unit for file read 
    5654      !!--------------------------------------------------------------------- 
    5755       
     
    6260      IF(lwp) WRITE(numout,*) '           jpnfl = ',jpnfl 
    6361       
    64       IF(ln_rstflo) THEN 
     62      !-------------------------! 
     63      ! FLOAT RESTART FILE READ ! 
     64      !-------------------------! 
     65      IF( ln_rstflo )THEN 
     66 
    6567         IF(lwp) WRITE(numout,*) '        float restart file read' 
    6668          
    6769         ! open the restart file  
     70         !---------------------- 
    6871         CALL ctl_opn( inum, 'restart_float', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
    6972 
     
    7780 
    7881         ! if we want a  surface drift  ( like PROVOR floats ) 
    79          IF( ln_argo ) THEN 
    80             DO jfl = 1, jpnrstflo 
    81                nisobfl(jfl) = 0 
    82             END DO 
    83          ENDIF 
    84  
    85          IF(lwp) WRITE(numout,*)' flo_dom: END of florstlec' 
     82         IF( ln_argo ) nisobfl(1:jpnrstflo) = 0 
    8683          
    8784         ! It is possible to add new floats.           
    88          IF(lwp) WRITE(numout,*)' flo_dom:jpnfl jpnrstflo ',jpnfl,jpnrstflo 
    89          IF( jpnfl > jpnrstflo ) THEN 
    90             ! open the init file  
    91             CALL ctl_opn( inum, 'init_float', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
    92             DO jfl = jpnrstflo+1, jpnfl 
    93                READ(inum,*) flxx(jfl),flyy(jfl),flzz(jfl), nisobfl(jfl),ngrpfl(jfl),jfl1 
    94             END DO 
    95             CLOSE(inum) 
    96             IF(lwp) WRITE(numout,*)' flodom: END reading init_float file' 
     85         !--------------------------------- 
     86         IF( jpnfl > jpnrstflo )THEN 
     87 
     88            IF(lwp) WRITE(numout,*) '        add new floats' 
     89 
     90            IF( ln_ariane )THEN  !Add new floats with ariane convention 
     91                CALL add_new_ariane_floats(jpnrstflo+1,jpnfl)  
     92            ELSE                 !Add new floats with long/lat convention 
     93                CALL add_new_floats(jpnrstflo+1,jpnfl) 
     94            ENDIF 
     95         ENDIF 
     96 
     97      !--------------------------------------! 
     98      ! FLOAT INITILISATION: NO RESTART FILE ! 
     99      !--------------------------------------! 
     100      ELSE    !ln_rstflo 
     101 
     102         IF( ln_ariane )THEN       !Add new floats with ariane convention 
     103            CALL add_new_ariane_floats(1,jpnfl) 
     104         ELSE                      !Add new floats with long/lat convention 
     105            CALL add_new_floats(1,jpnfl) 
     106         ENDIF 
     107 
     108      ENDIF 
    97109             
    98             ! Test to find the grid point coordonate with the geographical position             
    99             DO jfl = jpnrstflo+1, jpnfl 
    100                ihtest(jfl) = 0 
    101                ivtest(jfl) = 0 
    102                ikmfl(jfl) = 0 
     110   END SUBROUTINE flo_dom 
     111 
     112   SUBROUTINE add_new_floats(kfl_start, kfl_end) 
     113      !! ------------------------------------------------------------- 
     114      !!                 ***  SUBROUTINE add_new_arianefloats  *** 
     115      !!           
     116      !! ** Purpose :    
     117      !! 
     118      !!       First initialisation of floats 
     119      !!       the initials positions of floats are written in a file 
     120      !!       with a variable to know if it is a isobar float a number  
     121      !!       to identified who want the trajectories of this float and  
     122      !!       an index for the number of the float          
     123      !!       open the init file  
     124      !!                
     125      !! ** Method  :  
     126      !!---------------------------------------------------------------------- 
     127      INTEGER, INTENT(in) :: kfl_start, kfl_end 
     128      !! 
     129      INTEGER           :: inum ! file unit 
     130      INTEGER           :: jfl,ji, jj, jk ! dummy loop indices 
     131      INTEGER           :: itrash         ! trash var for reading 
     132      INTEGER           :: ifl            ! number of floats to read 
     133      REAL(wp)          :: zdxab, zdyad 
     134      LOGICAL           :: llinmesh 
     135      CHARACTER(len=80) :: cltmp 
     136 
     137      INTEGER , DIMENSION(jpnfl) ::   iimfl, ijmfl, ikmfl       ! index mesh of floats 
     138      INTEGER , DIMENSION(jpnfl) ::   idomfl, ivtest, ihtest    !   -      
     139      REAL(wp), DIMENSION(jpnfl) ::   zgifl, zgjfl,  zgkfl 
     140      !!--------------------------------------------------------------------- 
     141      ifl = kfl_end-kfl_start+1 
     142 
     143      ! we get the init values  
     144      !----------------------- 
     145      CALL ctl_opn( inum , clname1, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
     146      DO jfl = kfl_start,kfl_end 
     147         READ(inum,*) flxx(jfl),flyy(jfl),flzz(jfl), nisobfl(jfl),ngrpfl(jfl),itrash 
     148         if(lwp)write(numout,*)'read:',jfl,flxx(jfl),flyy(jfl),flzz(jfl), nisobfl(jfl),ngrpfl(jfl),itrash ; call flush(numout) 
     149      END DO 
     150      CLOSE(inum) 
     151             
     152      ! Test to find the grid point coordonate with the geographical position             
     153      !---------------------------------------------------------------------- 
     154      DO jfl = kfl_start,kfl_end 
     155         ihtest(jfl) = 0 
     156         ivtest(jfl) = 0 
     157         ikmfl(jfl) = 0 
    103158# if   defined key_mpp_mpi 
    104                DO ji = MAX(nldi,2), nlei 
    105                   DO jj = MAX(nldj,2), nlej   ! NO vector opt. 
    106 # else 
    107                DO ji = 2, jpi 
    108                   DO jj = 2, jpj   ! NO vector opt. 
     159         DO ji = MAX(nldi,2), nlei 
     160            DO jj = MAX(nldj,2), nlej   ! NO vector opt. 
     161# else          
     162         DO ji = 2, jpi 
     163            DO jj = 2, jpj   ! NO vector opt. 
    109164# endif                      
    110                      ! For each float we find the indexes of the mesh                       
    111                      CALL findmesh(glamf(ji-1,jj-1),gphif(ji-1,jj-1),   & 
    112                                    glamf(ji-1,jj  ),gphif(ji-1,jj  ),   & 
    113                                    glamf(ji  ,jj  ),gphif(ji  ,jj  ),   & 
    114                                    glamf(ji  ,jj-1),gphif(ji  ,jj-1),   & 
    115                                    flxx(jfl)       ,flyy(jfl)       ,   & 
    116                                    glamt(ji  ,jj  ),gphit(ji  ,jj  ), llinmesh) 
    117                      IF(llinmesh) THEN 
    118                         iimfl(jfl) = ji 
    119                         ijmfl(jfl) = jj 
    120                         ihtest(jfl) = ihtest(jfl)+1 
    121                         DO jk = 1, jpk-1 
    122                            IF( (fsdepw(ji,jj,jk) <= flzz(jfl)) .AND. (fsdepw(ji,jj,jk+1) > flzz(jfl)) ) THEN 
    123                               ikmfl(jfl) = jk 
    124                               ivtest(jfl) = ivtest(jfl) + 1 
    125                            ENDIF 
    126                         END DO 
     165               ! For each float we find the indexes of the mesh                       
     166               CALL findmesh(glamf(ji-1,jj-1),gphif(ji-1,jj-1),   & 
     167                             glamf(ji-1,jj  ),gphif(ji-1,jj  ),   & 
     168                             glamf(ji  ,jj  ),gphif(ji  ,jj  ),   & 
     169                             glamf(ji  ,jj-1),gphif(ji  ,jj-1),   & 
     170                             flxx(jfl)       ,flyy(jfl)       ,   & 
     171                             glamt(ji  ,jj  ),gphit(ji  ,jj  ), llinmesh) 
     172               IF( llinmesh )THEN 
     173                  iimfl(jfl) = ji 
     174                  ijmfl(jfl) = jj 
     175                  ihtest(jfl) = ihtest(jfl)+1 
     176                  DO jk = 1, jpk-1 
     177                     IF( (fsdepw(ji,jj,jk) <= flzz(jfl)) .AND. (fsdepw(ji,jj,jk+1) > flzz(jfl)) ) THEN 
     178                        ikmfl(jfl) = jk 
     179                        ivtest(jfl) = ivtest(jfl) + 1 
    127180                     ENDIF 
    128181                  END DO 
    129                END DO 
    130                IF(lwp) WRITE(numout,*)'   flo_dom: END findmesh' 
    131                 
    132                ! If the float is in a mesh computed by an other processor we put iimfl=ijmfl=-1                
    133                IF( ihtest(jfl) ==  0 ) THEN 
    134                   iimfl(jfl) = -1 
    135                   ijmfl(jfl) = -1 
    136182               ENDIF 
    137183            END DO 
     184         END DO 
     185 
     186         ! If the float is in a mesh computed by an other processor we put iimfl=ijmfl=-1                
     187         IF( ihtest(jfl) ==  0 ) THEN 
     188            iimfl(jfl) = -1 
     189            ijmfl(jfl) = -1 
     190         ENDIF 
     191      END DO 
     192 
     193      !Test if each float is in one and only one proc 
     194      !---------------------------------------------- 
     195      IF( lk_mpp )   THEN  
     196         CALL mpp_sum(ihtest,jpnfl) 
     197         CALL mpp_sum(ivtest,jpnfl) 
     198      ENDIF 
     199      DO jfl = kfl_start,kfl_end 
     200 
     201         IF( (ihtest(jfl) > 1 ) .OR. ( ivtest(jfl) > 1) ) THEN 
     202             WRITE(cltmp,'(A10,i4.4,A20)' )'THE FLOAT',jfl,' IS NOT IN ONLY ONE MESH' 
     203             CALL ctl_stop('STOP',TRIM(cltmp) ) 
     204         ENDIF 
     205         IF( (ihtest(jfl) == 0) ) THEN 
     206             WRITE(cltmp,'(A10,i4.4,A20)' )'THE FLOAT',jfl,' IS IN NO MESH' 
     207             CALL ctl_stop('STOP',TRIM(cltmp) ) 
     208         ENDIF 
     209      END DO 
     210 
     211      ! We compute the distance between the float and the face of the mesh             
     212      !------------------------------------------------------------------- 
     213      DO jfl = kfl_start,kfl_end 
     214 
     215         ! Made only if the float is in the domain of the processor               
     216         IF( (iimfl(jfl) >= 0) .AND. (ijmfl(jfl) >= 0) ) THEN 
     217 
     218            ! TEST TO KNOW IF THE FLOAT IS NOT INITIALISED IN THE COAST 
     219            idomfl(jfl) = 0 
     220            IF( tmask(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) == 0. ) idomfl(jfl) = 1 
     221 
     222            ! Computation of the distance between the float and the faces of the mesh 
     223            !            zdxab 
     224            !             . 
     225            !        B----.---------C 
     226            !        |    .         | 
     227            !        |<------>flo   | 
     228            !        |        ^     | 
     229            !        |        |.....|....zdyad 
     230            !        |        |     | 
     231            !        A--------|-----D 
     232            ! 
     233            zdxab = dstnce( flxx(jfl), flyy(jfl), glamf(iimfl(jfl)-1,ijmfl(jfl)-1), flyy(jfl) ) 
     234            zdyad = dstnce( flxx(jfl), flyy(jfl), flxx(jfl), gphif(iimfl(jfl)-1,ijmfl(jfl)-1) ) 
     235 
     236            ! Translation of this distances (in meter) in indexes 
     237            zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom) 
     238            zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom) 
     239            zgkfl(jfl) = (( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl))   & 
     240               &                 / (  fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              & 
     241               &                    - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ) )                             & 
     242               &                 + (( flzz(jfl)-fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) *(ikmfl(jfl)+1))   & 
     243               &                 / (  fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              & 
     244               &                    - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) 
     245         ELSE 
     246            zgifl(jfl) = 0.e0 
     247            zgjfl(jfl) = 0.e0 
     248            zgkfl(jfl) = 0.e0 
     249         ENDIF 
     250 
     251      END DO 
     252                   
     253      ! The sum of all the arrays zgifl, zgjfl, zgkfl give 3 arrays with the positions of all the floats. 
     254      IF( lk_mpp )   THEN  
     255         CALL mpp_sum( zgjfl, ifl )   ! sums over the global domain 
     256         CALL mpp_sum( zgkfl, ifl ) 
     257      ENDIF 
    138258             
    139             ! A zero in the sum of the arrays "ihtest" and "ivtest"              
    140 # if   defined key_mpp_mpi 
    141             CALL mpp_sum(ihtest,jpnfl) 
    142             CALL mpp_sum(ivtest,jpnfl) 
    143 # endif  
    144             DO jfl = jpnrstflo+1, jpnfl 
    145                IF( (ihtest(jfl) > 1 ) .OR. ( ivtest(jfl) > 1) ) THEN 
    146                   IF(lwp) WRITE(numout,*) 'THE FLOAT',jfl,' IS NOT IN ONLY ONE MESH' 
    147                   STOP 
    148                ENDIF 
    149                IF( (ihtest(jfl) == 0) ) THEN 
    150                   IF(lwp) WRITE(numout,*)'THE FLOAT',jfl,' IS IN NO MESH' 
    151                   STOP 
    152                ENDIF 
    153             END DO 
    154              
    155             ! We compute the distance between the float and the face of the mesh             
    156             DO jfl = jpnrstflo+1, jpnfl                
    157                ! Made only if the float is in the domain of the processor               
    158                IF( (iimfl(jfl) >= 0) .AND. (ijmfl(jfl) >= 0) ) THEN 
    159                    
    160                   ! TEST TO KNOW IF THE FLOAT IS NOT INITIALISED IN THE COAST 
    161                    
    162                   idomfl(jfl) = 0 
    163                   IF( tmask(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) == 0. ) idomfl(jfl) = 1 
    164                                             
    165                   ! Computation of the distance between the float and the faces of the mesh 
    166                   !            zdxab 
    167                   !             . 
    168                   !        B----.---------C 
    169                   !        |    .         | 
    170                   !        |<------>flo   | 
    171                   !        |        ^     | 
    172                   !        |        |.....|....zdyad 
    173                   !        |        |     | 
    174                   !        A--------|-----D 
    175                   ! 
    176               
    177                   zdxab = dstnce( flxx(jfl), flyy(jfl), glamf(iimfl(jfl)-1,ijmfl(jfl)-1), flyy(jfl) ) 
    178                   zdyad = dstnce( flxx(jfl), flyy(jfl), flxx(jfl), gphif(iimfl(jfl)-1,ijmfl(jfl)-1) ) 
    179                    
    180                   ! Translation of this distances (in meter) in indexes 
    181                    
    182                   zgifl(jfl-jpnrstflo)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom) 
    183                   zgjfl(jfl-jpnrstflo)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom) 
    184                   zgkfl(jfl-jpnrstflo) = (( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl))   & 
    185                      &                 / (  fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              & 
    186                      &                    - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ) )                             & 
    187                      &                 + (( flzz(jfl)-fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) *(ikmfl(jfl)+1))   & 
    188                      &                 / (  fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              & 
    189                      &                    - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) 
    190                ELSE 
    191                   zgifl(jfl-jpnrstflo) = 0.e0 
    192                   zgjfl(jfl-jpnrstflo) = 0.e0 
    193                   zgkfl(jfl-jpnrstflo) = 0.e0 
    194                ENDIF 
    195             END DO 
    196              
    197             ! The sum of all the arrays zgifl, zgjfl, zgkfl give 3 arrays with the positions of all the floats. 
    198             IF( lk_mpp )   THEN 
    199                CALL mpp_sum( zgjfl, jpnnewflo )   ! sums over the global domain 
    200                CALL mpp_sum( zgkfl, jpnnewflo ) 
    201                IF(lwp) WRITE(numout,*) (zgifl(jfl),jfl=1,jpnnewflo) 
    202                IF(lwp) WRITE(numout,*) (zgjfl(jfl),jfl=1,jpnnewflo) 
    203                IF(lwp) WRITE(numout,*) (zgkfl(jfl),jfl=1,jpnnewflo)  
    204             ENDIF 
    205             
    206             DO jfl = jpnrstflo+1, jpnfl 
    207                tpifl(jfl) = zgifl(jfl-jpnrstflo) 
    208                tpjfl(jfl) = zgjfl(jfl-jpnrstflo) 
    209                tpkfl(jfl) = zgkfl(jfl-jpnrstflo) 
    210             END DO 
    211          ENDIF 
    212       ELSE 
    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 ' 
    274           
    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 
    294 # if   defined key_mpp_mpi 
    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. 
    300 # endif                   
    301                      ! for each float we find the indexes of the mesh  
    302                    
    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 
    321                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 
    329           
    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 
    342          
    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 
    383           
    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  
    391       ENDIF 
    392              
    393       ! Print the initial positions of the floats 
     259      DO jfl = kfl_start,kfl_end 
     260         tpifl(jfl) = zgifl(jfl) 
     261         tpjfl(jfl) = zgjfl(jfl) 
     262         tpkfl(jfl) = zgkfl(jfl) 
     263      END DO 
     264 
     265      ! WARNING : initial position not in the sea          
    394266      IF( .NOT. ln_rstflo ) THEN  
    395          ! WARNING : initial position not in the sea          
    396          DO jfl = 1, jpnfl 
     267         DO jfl =  kfl_start,kfl_end 
    397268            IF( idomfl(jfl) == 1 ) THEN 
    398269               IF(lwp) WRITE(numout,*)'*****************************' 
     
    406277      ENDIF 
    407278 
    408    END SUBROUTINE flo_dom 
     279   END SUBROUTINE add_new_floats 
     280 
     281   SUBROUTINE add_new_ariane_floats(kfl_start, kfl_end) 
     282      !! ------------------------------------------------------------- 
     283      !!                 ***  SUBROUTINE add_new_arianefloats  *** 
     284      !!           
     285      !! ** Purpose :    
     286      !!       First initialisation of floats with ariane convention 
     287      !!        
     288      !!       The indexes are read directly from file (warning ariane 
     289      !!       convention, are refered to  
     290      !!       U,V,W grids - and not T-)  
     291      !!       The isobar advection is managed with the sign of tpkfl ( >0 -> 3D 
     292      !!       advection, <0 -> 2D)  
     293      !!       Some variables are not read, as - gl         : time index; 4th 
     294      !!       column         
     295      !!                                       - transport  : transport ; 5th 
     296      !!                                       column 
     297      !!       and paste in the jtrash var 
     298      !!       At the end, ones need to replace the indexes on T grid 
     299      !!       RMQ : there is no float groups identification ! 
     300      !! 
     301      !!                
     302      !! ** Method  :  
     303      !!---------------------------------------------------------------------- 
     304      INTEGER, INTENT(in) :: kfl_start, kfl_end 
     305      !! 
     306      INTEGER  :: inum         ! file unit 
     307      INTEGER  :: ierr, ifl 
     308      INTEGER  :: jfl, jfl1    ! dummy loop indices 
     309      INTEGER  :: itrash       ! trash var for reading   
     310      CHARACTER(len=80) :: cltmp 
     311 
     312      !!---------------------------------------------------------------------- 
     313      nisobfl(kfl_start:kfl_end) = 1 ! we assume that by default we want 3D advection 
     314 
     315      ifl = kfl_end - kfl_start + 1  ! number of floats to read   
     316 
     317      ! we check that the number of floats in the init_file are consistant with the namelist 
     318      IF( lwp ) THEN 
     319 
     320         jfl1=0 
     321         CALL ctl_opn( inum, clname2, 'OLD', 'FORMATTED', 'SEQUENTIAL',  1, numout, .TRUE., 1 ) 
     322         DO WHILE (ierr .GE. 0) 
     323            jfl1=jfl1+1 
     324            READ (inum,*, iostat=ierr) 
     325         END DO 
     326         CLOSE(inum) 
     327         IF( (jfl1-1) .NE. ifl )THEN  
     328            WRITE(cltmp,'(A20,A20,A3,i4.4,A10,i4.4)')"the number of floats in",TRIM(clname2), & 
     329                                                     " = ",jfl1," is not equal to jfl= ",ifl 
     330            CALL ctl_stop('STOP',TRIM(cltmp) ) 
     331         ENDIF 
     332 
     333      ENDIF 
     334             
     335      ! we get the init values  
     336      CALL ctl_opn( inum, clname2, 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .TRUE., 1 ) 
     337      DO jfl = kfl_start, kfl_end 
     338          READ(inum,*) tpifl(jfl),tpjfl(jfl),tpkfl(jfl),itrash, itrash 
     339               
     340          IF ( tpkfl(jfl) .LT. 0. ) nisobfl(jfl) = 0 !set the 2D advection according to init_float 
     341          ngrpfl(jfl)=jfl 
     342      END DO 
     343 
     344      ! conversion from ariane index to T grid index 
     345      tpkfl(kfl_start:kfl_end) = abs(tpkfl)-0.5 ! reversed vertical axis 
     346      tpifl(kfl_start:kfl_end) = tpifl+0.5 
     347      tpjfl(kfl_start:kfl_end) = tpjfl+0.5 
     348 
     349 
     350   END SUBROUTINE add_new_ariane_floats 
    409351 
    410352 
     
    500442   END FUNCTION dstnce 
    501443 
     444 
    502445#  else 
    503446   !!---------------------------------------------------------------------- 
     
    506449CONTAINS 
    507450   SUBROUTINE flo_dom                 ! Empty routine 
     451         WRITE(*,*) 'flo_dom: : You should not have seen this print! error?' 
    508452   END SUBROUTINE flo_dom 
    509453#endif 
  • branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90

    r2839 r2843  
    6868         IF(lwp) THEN 
    6969            WRITE(numout,*) 
    70             WRITE(numout,*) 'flo_wri : write in  restart_float file ' 
     70            WRITE(numout,*) 'flo_rst : write in  restart_float file ' 
    7171            WRITE(numout,*) '~~~~~~~    ' 
    7272         ENDIF 
Note: See TracChangeset for help on using the changeset viewer.