New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 6140 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90 – NEMO

Ignore:
Timestamp:
2015-12-21T12:35:23+01:00 (8 years ago)
Author:
timgraham
Message:

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r5836 r6140  
    44   !! Ocean forcing:  read input field for surface boundary condition 
    55   !!===================================================================== 
    6    !! History :  2.0  !  06-2006  (S. Masson, G. Madec) Original code 
    7    !!                 !  05-2008  (S. Alderson) Modified for Interpolation in memory 
    8    !!                 !                         from input grid to model grid 
    9    !!                 !  10-2013  (D. Delrosso, P. Oddo) implement suppression of  
    10    !!                 !                         land point prior to interpolation 
     6   !! History :  2.0  !  06-2006  (S. Masson, G. Madec)  Original code 
     7   !!                 !  05-2008  (S. Alderson)  Modified for Interpolation in memory from input grid to model grid 
     8   !!                 !  10-2013  (D. Delrosso, P. Oddo)  suppression of land point prior to interpolation 
    119   !!---------------------------------------------------------------------- 
    1210 
     
    1513   !!                   surface boundary condition 
    1614   !!---------------------------------------------------------------------- 
    17    USE oce             ! ocean dynamics and tracers 
    18    USE dom_oce         ! ocean space and time domain 
    19    USE phycst          ! ??? 
    20    USE in_out_manager  ! I/O manager 
    21    USE iom             ! I/O manager library 
    22    USE geo2ocean       ! for vector rotation on to model grid 
    23    USE lib_mpp         ! MPP library 
    24    USE wrk_nemo        ! work arrays 
    25    USE lbclnk          ! ocean lateral boundary conditions (C1D case) 
    26    USE ioipsl, ONLY :   ymds2ju, ju2ymds   ! for calendar 
    27    USE sbc_oce 
     15   USE oce            ! ocean dynamics and tracers 
     16   USE dom_oce        ! ocean space and time domain 
     17   USE phycst         ! physical constant 
     18   USE sbc_oce        ! surface boundary conditions : fields 
     19   USE geo2ocean      ! for vector rotation on to model grid 
     20   ! 
     21   USE in_out_manager ! I/O manager 
     22   USE iom            ! I/O manager library 
     23   USE ioipsl  , ONLY : ymds2ju, ju2ymds   ! for calendar 
     24   USE lib_mpp        ! MPP library 
     25   USE wrk_nemo       ! work arrays 
     26   USE lbclnk         ! ocean lateral boundary conditions (C1D case) 
    2827    
    2928   IMPLICIT NONE 
     
    6059      INTEGER , DIMENSION(2)          ::   nrec_b       ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year) 
    6160      INTEGER , DIMENSION(2)          ::   nrec_a       ! after  record (1: index, 2: second since Jan. 1st 00h of nit000 year) 
    62       REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:  ) ::   fnow       ! input fields interpolated to now time step 
    63       REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta       ! 2 consecutive record of input fields 
     61      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:  ) ::   fnow   ! input fields interpolated to now time step 
     62      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta   ! 2 consecutive record of input fields 
    6463      CHARACTER(len = 256)            ::   wgtname      ! current name of the NetCDF weight file acting as a key 
    6564      !                                                 ! into the WGTLIST structure 
     
    133132      INTEGER  , INTENT(in   ), OPTIONAL     ::   kit       ! subcycle timestep for timesplitting option 
    134133      INTEGER  , INTENT(in   ), OPTIONAL     ::   kt_offset ! provide fields at time other than "now" 
    135                                                             !   kt_offset = -1 => fields at "before" time level 
    136                                                             !   kt_offset = +1 => fields at "after"  time level 
    137                                                             !   etc. 
    138       !! 
    139       INTEGER  ::   itmp       ! temporary variable 
    140       INTEGER  ::   imf        ! size of the structure sd 
    141       INTEGER  ::   jf         ! dummy indices 
    142       INTEGER  ::   isecend    ! number of second since Jan. 1st 00h of nit000 year at nitend 
    143       INTEGER  ::   isecsbc    ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step 
    144       INTEGER  ::   it_offset  ! local time offset variable 
    145       LOGICAL  ::   llnxtyr    ! open next year  file? 
    146       LOGICAL  ::   llnxtmth   ! open next month file? 
    147       LOGICAL  ::   llstop     ! stop is the file does not exist 
     134      !                                                     !   kt_offset = -1 => fields at "before" time level 
     135      !                                                     !   kt_offset = +1 => fields at "after"  time level 
     136      !                                                     !   etc. 
     137      INTEGER  ::   itmp         ! local variable 
     138      INTEGER  ::   imf          ! size of the structure sd 
     139      INTEGER  ::   jf           ! dummy indices 
     140      INTEGER  ::   isecend      ! number of second since Jan. 1st 00h of nit000 year at nitend 
     141      INTEGER  ::   isecsbc      ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step 
     142      INTEGER  ::   it_offset    ! local time offset variable 
     143      LOGICAL  ::   llnxtyr      ! open next year  file? 
     144      LOGICAL  ::   llnxtmth     ! open next month file? 
     145      LOGICAL  ::   llstop       ! stop is the file does not exist 
    148146      LOGICAL  ::   ll_firstcall ! true if this is the first call to fld_read for this set of fields 
    149       REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation 
    150       REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation 
    151       CHARACTER(LEN=1000) ::   clfmt   ! write format 
    152       TYPE(MAP_POINTER) ::   imap   ! global-to-local mapping indices 
     147      REAL(wp) ::   ztinta       ! ratio applied to after  records when doing time interpolation 
     148      REAL(wp) ::   ztintb       ! ratio applied to before records when doing time interpolation 
     149      CHARACTER(LEN=1000) ::   clfmt  ! write format 
     150      TYPE(MAP_POINTER)   ::   imap   ! global-to-local mapping indices 
    153151      !!--------------------------------------------------------------------- 
    154152      ll_firstcall = kt == nit000 
     
    166164         isecsbc = nsec_year + nsec1jan000 + (kit+it_offset)*NINT( rdt/REAL(nn_baro,wp) ) 
    167165      ELSE                      ! middle of sbc time step 
    168          isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) + it_offset * NINT(rdttra(1)) 
     166         isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdt) + it_offset * NINT(rdt) 
    169167      ENDIF 
    170168      imf = SIZE( sd ) 
     
    193191               CALL fld_rec( kn_fsbc, sd(jf), kt_offset = it_offset, kit = kit )    ! update after record informations 
    194192 
    195                ! if kn_fsbc*rdttra is larger than nfreqh (which is kind of odd), 
     193               ! if kn_fsbc*rdt is larger than nfreqh (which is kind of odd), 
    196194               ! it is possible that the before value is no more the good one... we have to re-read it 
    197195               ! if before is not the last record of the file currently opened and after is the first record to be read 
     
    214212               IF( sd(jf)%ln_tint ) THEN 
    215213                   
    216                   ! if kn_fsbc*rdttra is larger than nfreqh (which is kind of odd), 
     214                  ! if kn_fsbc*rdt is larger than nfreqh (which is kind of odd), 
    217215                  ! it is possible that the before value is no more the good one... we have to re-read it 
    218216                  ! if before record is not just just before the after record... 
     
    245243                        ! year/month/week/day file to be not present. If the run continue further than the current 
    246244                        ! year/month/week/day, next year/month/week/day file must exist 
    247                         isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdttra(1))   ! second at the end of the run  
     245                        isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdt)   ! second at the end of the run 
    248246                        llstop = isecend > sd(jf)%nrec_a(2)                                   ! read more than 1 record of next year 
    249247                        ! we suppose that the date of next file is next day (should be ok even for weekly files...) 
     
    299297         END DO                                    ! --- end loop over field --- ! 
    300298         ! 
    301          !                                         ! ====================================== ! 
    302       ENDIF                                        ! update field at each kn_fsbc time-step ! 
    303       !                                            ! ====================================== ! 
     299      ENDIF 
    304300      ! 
    305301   END SUBROUTINE fld_read 
     
    333329      llprevday  = .FALSE. 
    334330      isec_week  = 0 
    335              
     331      ! 
    336332      ! define record informations 
    337333      CALL fld_rec( kn_fsbc, sdjf, ldbefore = .TRUE. )  ! return before values in sdjf%nrec_a (as we will swap it later) 
    338  
     334      ! 
    339335      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar  
    340  
     336      ! 
    341337      IF( sdjf%ln_tint ) THEN ! we need to read the previous record and we will put it in the current record structure 
    342  
     338         ! 
    343339         IF( sdjf%nrec_a(1) == 0  ) THEN   ! we redefine record sdjf%nrec_a(1) with the last record of previous year file 
    344340            IF    ( sdjf%nfreqh == -12 ) THEN   ! yearly mean 
     
    391387         ! 
    392388         CALL fld_clopn( sdjf, iyear, imonth, iday, .NOT. llprev ) 
    393  
     389         ! 
    394390         ! if previous year/month/day file does not exist, we switch to the current year/month/day 
    395391         IF( llprev .AND. sdjf%num <= 0 ) THEN 
     
    401397            CALL fld_clopn( sdjf ) 
    402398         ENDIF 
    403           
     399         ! 
    404400         IF( llprev ) THEN   ! check if the record sdjf%nrec_a(1) exists in the file 
    405401            idvar = iom_varid( sdjf%num, sdjf%clvar )                                        ! id of the variable sdjf%clvar 
     
    408404            sdjf%nrec_a(1) = MIN( sdjf%nrec_a(1), inrec )   ! make sure we select an existing record 
    409405         ENDIF 
    410  
    411          ! read before data in after arrays(as we will swap it later) 
    412          CALL fld_get( sdjf, map ) 
    413  
     406         ! 
     407         CALL fld_get( sdjf, map )         ! read before data in after arrays(as we will swap it later) 
     408         ! 
    414409         clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i6, ' at time = ', f7.2, ' days')" 
    415410         IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday 
    416  
     411         ! 
    417412      ENDIF 
    418413      ! 
     
    435430      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldbefore  ! sent back before record values (default = .FALSE.) 
    436431      INTEGER  , INTENT(in   ), OPTIONAL ::   kit       ! index of barotropic subcycle 
    437                                                         ! used only if sdjf%ln_tint = .TRUE. 
     432      !                                                 ! used only if sdjf%ln_tint = .TRUE. 
    438433      INTEGER  , INTENT(in   ), OPTIONAL ::   kt_offset ! Offset of required time level compared to "now" 
    439                                                         !   time level in units of time steps. 
    440       !! 
     434      !                                                 !   time level in units of time steps. 
     435      ! 
    441436      LOGICAL  ::   llbefore    ! local definition of ldbefore 
    442437      INTEGER  ::   iendrec     ! end of this record (in seconds) 
     
    459454      IF( PRESENT(kt_offset) )   it_offset = kt_offset 
    460455      IF( PRESENT(kit) ) THEN   ;   it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) ) 
    461       ELSE                      ;   it_offset =         it_offset   * NINT(       rdttra(1)      ) 
     456      ELSE                      ;   it_offset =         it_offset   * NINT(       rdt            ) 
    462457      ENDIF 
    463458      ! 
     
    536531         ELSE                                           ;   ztmp = REAL(nsec_year ,wp)  ! since 00h on Jan 1 of the current year 
    537532         ENDIF 
    538          ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1) + REAL( it_offset, wp )  ! centrered in the middle of sbc time step 
    539          ztmp = ztmp + 0.01 * rdttra(1)                                                 ! avoid truncation error  
     533         ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdt + REAL( it_offset, wp )        ! centrered in the middle of sbc time step 
     534         ztmp = ztmp + 0.01 * rdt                                                       ! avoid truncation error  
    540535         IF( sdjf%ln_tint ) THEN                ! time interpolation, shift by 1/2 record 
    541536            ! 
     
    592587      !! ** Purpose :   read the data 
    593588      !!---------------------------------------------------------------------- 
    594       TYPE(FLD), INTENT(inout) ::   sdjf   ! input field related variables 
    595       TYPE(MAP_POINTER),INTENT(in) ::   map   ! global-to-local mapping indices 
    596       !! 
    597       INTEGER                  ::   ipk    ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    598       INTEGER                  ::   iw     ! index into wgts array 
    599       INTEGER                  ::   ipdom  ! index of the domain 
    600       INTEGER                  ::   idvar  ! variable ID 
    601       INTEGER                  ::   idmspc ! number of spatial dimensions 
    602       LOGICAL                  ::   lmoor  ! C1D case: point data 
     589      TYPE(FLD)        , INTENT(inout) ::   sdjf   ! input field related variables 
     590      TYPE(MAP_POINTER), INTENT(in   ) ::   map    ! global-to-local mapping indices 
     591      ! 
     592      INTEGER ::   ipk      ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
     593      INTEGER ::   iw       ! index into wgts array 
     594      INTEGER ::   ipdom    ! index of the domain 
     595      INTEGER ::   idvar    ! variable ID 
     596      INTEGER ::   idmspc  ! number of spatial dimensions 
     597      LOGICAL ::   lmoor    ! C1D case: point data 
    603598      !!--------------------------------------------------------------------- 
    604599      ! 
     
    611606      ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
    612607         CALL wgt_list( sdjf, iw ) 
    613          IF( sdjf%ln_tint ) THEN   ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fdta(:,:,:,2), &  
    614               & sdjf%nrec_a(1), sdjf%lsmname ) 
    615          ELSE                      ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fnow(:,:,:  ), & 
    616               & sdjf%nrec_a(1), sdjf%lsmname ) 
     608         IF( sdjf%ln_tint ) THEN   ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, sdjf%fdta(:,:,:,2),          &  
     609            &                                                                          sdjf%nrec_a(1), sdjf%lsmname ) 
     610         ELSE                      ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, sdjf%fnow(:,:,:  ),          & 
     611            &                                                                          sdjf%nrec_a(1), sdjf%lsmname ) 
    617612         ENDIF 
    618613      ELSE 
    619          IF( SIZE(sdjf%fnow, 1) == jpi ) THEN  ;  ipdom = jpdom_data 
    620          ELSE                                  ;  ipdom = jpdom_unknown 
     614         IF( SIZE(sdjf%fnow, 1) == jpi ) THEN   ;   ipdom = jpdom_data 
     615         ELSE                                   ;   ipdom = jpdom_unknown 
    621616         ENDIF 
    622617         ! C1D case: If product of spatial dimensions == ipk, then x,y are of 
    623618         ! size 1 (point/mooring data): this must be read onto the central grid point 
    624619         idvar  = iom_varid( sdjf%num, sdjf%clvar ) 
    625          idmspc = iom_file( sdjf%num )%ndims( idvar ) 
     620         idmspc = iom_file ( sdjf%num )%ndims( idvar ) 
    626621         IF( iom_file( sdjf%num )%luld( idvar ) )   idmspc = idmspc - 1 
    627          lmoor  = (idmspc == 0 .OR. PRODUCT( iom_file( sdjf%num )%dimsz( 1:MAX(idmspc,1) ,idvar ) ) == ipk) 
     622         lmoor  = (  idmspc == 0 .OR. PRODUCT( iom_file( sdjf%num )%dimsz( 1:MAX(idmspc,1) ,idvar ) ) == ipk  ) 
    628623         ! 
    629624         SELECT CASE( ipk ) 
     
    660655      ! 
    661656      sdjf%rotn(2) = .false.   ! vector not yet rotated 
    662  
     657      ! 
    663658   END SUBROUTINE fld_get 
     659 
    664660 
    665661   SUBROUTINE fld_map( num, clvar, dta, nrec, map ) 
     
    688684      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read  ! work space for global data 
    689685      !!--------------------------------------------------------------------- 
    690              
     686      ! 
    691687      ipi = SIZE( dta, 1 ) 
    692688      ipj = 1 
    693689      ipk = SIZE( dta, 3 ) 
    694  
     690      ! 
    695691      idvar   = iom_varid( num, clvar ) 
    696692      ilendta = iom_file(num)%dimsz(1,idvar) 
     
    698694#if defined key_bdy 
    699695      ipj = iom_file(num)%dimsz(2,idvar) 
    700       IF ( map%ll_unstruc) THEN ! unstructured open boundary data file 
     696      IF( map%ll_unstruc) THEN  ! unstructured open boundary data file 
    701697         dta_read => dta_global 
    702       ELSE                      ! structured open boundary data file 
     698      ELSE                       ! structured open boundary data file 
    703699         dta_read => dta_global2 
    704700      ENDIF 
    705701#endif 
    706702 
    707       IF(lwp) WRITE(numout,*) 'Dim size for ',TRIM(clvar),' is ', ilendta 
     703      IF(lwp) WRITE(numout,*) 'Dim size for ',        TRIM(clvar),' is ', ilendta 
    708704      IF(lwp) WRITE(numout,*) 'Number of levels for ',TRIM(clvar),' is ', ipk 
    709  
     705      ! 
    710706      SELECT CASE( ipk ) 
    711707      CASE(1)        ;   CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1    ), nrec ) 
     
    713709      END SELECT 
    714710      ! 
    715       IF ( map%ll_unstruc ) THEN ! unstructured open boundary data file 
     711      IF( map%ll_unstruc ) THEN ! unstructured open boundary data file 
    716712         DO ib = 1, ipi 
    717713            DO ik = 1, ipk 
     
    728724         END DO 
    729725      ENDIF 
    730  
     726      ! 
    731727   END SUBROUTINE fld_map 
    732728 
     
    738734      !! ** Purpose :   Vector fields may need to be rotated onto the local grid direction 
    739735      !!---------------------------------------------------------------------- 
    740       INTEGER  , INTENT(in   )               ::   kt        ! ocean time step 
    741       TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables 
    742       !! 
    743       INTEGER                           ::   ju,jv,jk,jn  ! loop indices 
    744       INTEGER                           ::   imf          ! size of the structure sd 
    745       INTEGER                           ::   ill          ! character length 
    746       INTEGER                           ::   iv           ! indice of V component 
     736      INTEGER                , INTENT(in   ) ::   kt   ! ocean time step 
     737      TYPE(FLD), DIMENSION(:), INTENT(inout) ::   sd   ! input field related variables 
     738      ! 
     739      INTEGER ::   ju, jv, jk, jn  ! loop indices 
     740      INTEGER ::   imf             ! size of the structure sd 
     741      INTEGER ::   ill             ! character length 
     742      INTEGER ::   iv              ! indice of V component 
     743      CHARACTER (LEN=100)               ::   clcomp       ! dummy weight name 
    747744      REAL(wp), POINTER, DIMENSION(:,:) ::   utmp, vtmp   ! temporary arrays for vector rotation 
    748       CHARACTER (LEN=100)               ::   clcomp       ! dummy weight name 
    749       !!--------------------------------------------------------------------- 
    750  
    751       CALL wrk_alloc( jpi,jpj, utmp, vtmp ) 
    752  
     745      !!--------------------------------------------------------------------- 
     746      ! 
     747      CALL wrk_alloc( jpi,jpj,   utmp, vtmp ) 
     748      ! 
    753749      !! (sga: following code should be modified so that pairs arent searched for each time 
    754750      ! 
     
    786782       END DO 
    787783      ! 
    788       CALL wrk_dealloc( jpi,jpj, utmp, vtmp ) 
     784      CALL wrk_dealloc( jpi,jpj,   utmp, vtmp ) 
    789785      ! 
    790786   END SUBROUTINE fld_rot 
     
    802798      INTEGER, OPTIONAL, INTENT(in   ) ::   kday     ! day value 
    803799      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.) 
    804       !! 
     800      ! 
    805801      LOGICAL :: llprevyr              ! are we reading previous year  file? 
    806802      LOGICAL :: llprevmth             ! are we reading previous month file? 
     
    853849      ! 
    854850      IF( TRIM(clname) /= TRIM(sdjf%clname) .OR. sdjf%num == 0 ) THEN   ! new file to be open  
    855  
     851         ! 
    856852         sdjf%clname = TRIM(clname) 
    857853         IF( sdjf%num /= 0 )   CALL iom_close( sdjf%num )   ! close file if already open 
    858854         CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 ) 
    859  
     855         ! 
    860856         ! find the last record to be read -> update sdjf%nreclast 
    861857         indexyr = iyear - nyear + 1 
     
    866862         CASE ( 2 )   ;   imonth_len = 31   ! next     year -> imonth = 1 
    867863         END SELECT 
    868           
     864         ! 
    869865         ! last record to be read in the current file 
    870866         IF    ( sdjf%nfreqh == -12 ) THEN                 ;   sdjf%nreclast = 1    !  yearly mean 
     
    880876            ENDIF 
    881877         ENDIF 
    882           
     878         ! 
    883879      ENDIF 
    884880      ! 
     
    901897      INTEGER  ::   jf       ! dummy indices 
    902898      !!--------------------------------------------------------------------- 
    903  
     899      ! 
    904900      DO jf = 1, SIZE(sdf) 
    905901         sdf(jf)%clrootname = TRIM( cdir )//TRIM( sdf_n(jf)%clname ) 
     
    923919         sdf(jf)%nreclast = -1 ! Set to non zero default value to avoid errors, is updated to meaningful value during fld_clopn 
    924920      END DO 
    925  
     921      ! 
    926922      IF(lwp) THEN      ! control print 
    927923         WRITE(numout,*) 
     
    943939         END DO 
    944940      ENDIF 
    945        
     941      ! 
    946942   END SUBROUTINE fld_fill 
    947943 
     
    958954      TYPE( FLD ), INTENT(in   ) ::   sd        ! field with name of weights file 
    959955      INTEGER    , INTENT(inout) ::   kwgt      ! index of weights 
    960       !! 
     956      ! 
    961957      INTEGER ::   kw, nestid   ! local integer 
    962958      LOGICAL ::   found        ! local logical 
     
    966962      !! weights filename is either present or we hit the end of the list 
    967963      found = .FALSE. 
    968  
     964      ! 
    969965      !! because agrif nest part of filenames are now added in iom_open 
    970966      !! to distinguish between weights files on the different grids, need to track 
     
    10281024      TYPE( FLD ), INTENT(in) ::   sd   ! field with name of weights file 
    10291025      !! 
    1030       INTEGER                           ::   jn            ! dummy loop indices 
    1031       INTEGER                           ::   inum          ! temporary logical unit 
    1032       INTEGER                           ::   id            ! temporary variable id 
    1033       INTEGER                           ::   ipk           ! temporary vertical dimension 
    1034       CHARACTER (len=5)                 ::   aname 
     1026      INTEGER ::   jn         ! dummy loop indices 
     1027      INTEGER ::   inum       ! local logical unit 
     1028      INTEGER ::   id         ! local variable id 
     1029      INTEGER ::   ipk        ! local vertical dimension 
     1030      INTEGER ::   zwrap      ! local integer 
     1031      LOGICAL ::   cyclical   !  
     1032      CHARACTER (len=5) ::   aname   ! 
    10351033      INTEGER , DIMENSION(:), ALLOCATABLE ::   ddims 
    10361034      INTEGER , POINTER, DIMENSION(:,:) ::   data_src 
    10371035      REAL(wp), POINTER, DIMENSION(:,:) ::   data_tmp 
    1038       LOGICAL                           ::   cyclical 
    1039       INTEGER                           ::   zwrap      ! local integer 
    1040       !!---------------------------------------------------------------------- 
    1041       ! 
    1042       CALL wrk_alloc( jpi,jpj, data_src )   ! integer 
    1043       CALL wrk_alloc( jpi,jpj, data_tmp ) 
     1036      !!---------------------------------------------------------------------- 
     1037      ! 
     1038      CALL wrk_alloc( jpi,jpj,   data_src )   ! integer 
     1039      CALL wrk_alloc( jpi,jpj,   data_tmp ) 
    10441040      ! 
    10451041      IF( nxt_wgt > tot_wgts ) THEN 
     
    11511147         ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3 ,ipk) ) 
    11521148         IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col(1,ref_wgts(nxt_wgt)%jpjwgt+3,ipk) ) 
    1153  
     1149         ! 
    11541150         nxt_wgt = nxt_wgt + 1 
    1155  
     1151         ! 
    11561152      ELSE  
    11571153         CALL ctl_stop( '    fld_weight : unable to read the file ' ) 
     
    11661162 
    11671163 
    1168    SUBROUTINE apply_seaoverland(clmaskfile,zfieldo,jpi1_lsm,jpi2_lsm,jpj1_lsm, & 
    1169                           &      jpj2_lsm,itmpi,itmpj,itmpz,rec1_lsm,recn_lsm) 
     1164   SUBROUTINE apply_seaoverland( clmaskfile, zfieldo, jpi1_lsm, jpi2_lsm, jpj1_lsm,  & 
     1165                          &      jpj2_lsm, itmpi, itmpj, itmpz, rec1_lsm, recn_lsm ) 
    11701166      !!--------------------------------------------------------------------- 
    11711167      !!                    ***  ROUTINE apply_seaoverland  *** 
     
    11761172      !!      D. Delrosso INGV           
    11771173      !!----------------------------------------------------------------------  
    1178       INTEGER                                   :: inum,jni,jnj,jnz,jc                  ! temporary indices 
    1179       INTEGER,                   INTENT(in)     :: itmpi,itmpj,itmpz                    ! lengths 
    1180       INTEGER,                   INTENT(in)     :: jpi1_lsm,jpi2_lsm,jpj1_lsm,jpj2_lsm  ! temporary indices 
    1181       INTEGER, DIMENSION(3),     INTENT(in)     :: rec1_lsm,recn_lsm                    ! temporary arrays for start and length 
    1182       REAL(wp),DIMENSION (:,:,:),INTENT(inout)  :: zfieldo                              ! input/output array for seaoverland application 
    1183       REAL(wp),DIMENSION (:,:,:),ALLOCATABLE    :: zslmec1                              ! temporary array for land point detection 
    1184       REAL(wp),DIMENSION (:,:),  ALLOCATABLE    :: zfieldn                              ! array of forcing field with undeff for land points 
    1185       REAL(wp),DIMENSION (:,:),  ALLOCATABLE    :: zfield                               ! array of forcing field 
    1186       CHARACTER (len=100),       INTENT(in)     :: clmaskfile                           ! land/sea mask file name 
    1187       !!--------------------------------------------------------------------- 
    1188       ALLOCATE ( zslmec1(itmpi,itmpj,itmpz) ) 
    1189       ALLOCATE ( zfieldn(itmpi,itmpj) ) 
    1190       ALLOCATE ( zfield(itmpi,itmpj) ) 
    1191  
     1174      INTEGER,                   INTENT(in   ) :: itmpi,itmpj,itmpz                    ! lengths 
     1175      INTEGER,                   INTENT(in   ) :: jpi1_lsm,jpi2_lsm,jpj1_lsm,jpj2_lsm  ! temporary indices 
     1176      INTEGER, DIMENSION(3),     INTENT(in   ) :: rec1_lsm,recn_lsm                    ! temporary arrays for start and length 
     1177      REAL(wp),DIMENSION (:,:,:),INTENT(inout) :: zfieldo                              ! input/output array for seaoverland application 
     1178      CHARACTER (len=100),       INTENT(in   ) :: clmaskfile                           ! land/sea mask file name 
     1179      ! 
     1180      INTEGER :: inum,jni,jnj,jnz,jc   ! local indices 
     1181      REAL(wp),DIMENSION (:,:,:),ALLOCATABLE :: zslmec1             ! local array for land point detection 
     1182      REAL(wp),DIMENSION (:,:),  ALLOCATABLE :: zfieldn   ! array of forcing field with undeff for land points 
     1183      REAL(wp),DIMENSION (:,:),  ALLOCATABLE :: zfield    ! array of forcing field 
     1184      !!--------------------------------------------------------------------- 
     1185      ! 
     1186      ALLOCATE ( zslmec1(itmpi,itmpj,itmpz), zfieldn(itmpi,itmpj), zfield(itmpi,itmpj) ) 
     1187      ! 
    11921188      ! Retrieve the land sea mask data 
    11931189      CALL iom_open( clmaskfile, inum ) 
    11941190      SELECT CASE( SIZE(zfieldo(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),3) ) 
    11951191      CASE(1) 
    1196            CALL iom_get( inum, jpdom_unknown, 'LSM', zslmec1(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,1), 1, rec1_lsm, recn_lsm) 
     1192         CALL iom_get( inum, jpdom_unknown, 'LSM', zslmec1(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,1), 1, rec1_lsm, recn_lsm) 
    11971193      CASE DEFAULT 
    1198            CALL iom_get( inum, jpdom_unknown, 'LSM', zslmec1(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:), 1, rec1_lsm, recn_lsm) 
     1194         CALL iom_get( inum, jpdom_unknown, 'LSM', zslmec1(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:), 1, rec1_lsm, recn_lsm) 
    11991195      END SELECT 
    12001196      CALL iom_close( inum ) 
    1201  
    1202       DO jnz=1,rec1_lsm(3)                            !! Loop over k dimension 
    1203  
    1204          DO jni=1,itmpi                               !! copy the original field into a tmp array 
    1205             DO jnj=1,itmpj                            !! substituting undeff over land points 
    1206             zfieldn(jni,jnj) = zfieldo(jni,jnj,jnz) 
    1207                IF ( zslmec1(jni,jnj,jnz) == 1. ) THEN 
    1208                   zfieldn(jni,jnj) = undeff_lsm 
    1209                ENDIF 
     1197      ! 
     1198      DO jnz=1,rec1_lsm(3)             !! Loop over k dimension 
     1199         ! 
     1200         DO jni = 1, itmpi                               !! copy the original field into a tmp array 
     1201            DO jnj = 1, itmpj                            !! substituting undeff over land points 
     1202               zfieldn(jni,jnj) = zfieldo(jni,jnj,jnz) 
     1203               IF( zslmec1(jni,jnj,jnz) == 1. )   zfieldn(jni,jnj) = undeff_lsm 
    12101204            END DO 
    12111205         END DO 
    1212    
    1213       CALL seaoverland(zfieldn,itmpi,itmpj,zfield) 
    1214       DO jc=1,nn_lsm 
    1215          CALL seaoverland(zfield,itmpi,itmpj,zfield) 
    1216       END DO 
    1217  
    1218       !   Check for Undeff and substitute original values 
    1219       IF(ANY(zfield==undeff_lsm)) THEN 
    1220          DO jni=1,itmpi 
    1221             DO jnj=1,itmpj 
    1222                IF (zfield(jni,jnj)==undeff_lsm) THEN 
    1223                   zfield(jni,jnj) = zfieldo(jni,jnj,jnz) 
    1224                ENDIF 
    1225             ENDDO 
    1226          ENDDO 
    1227       ENDIF 
    1228  
    1229       zfieldo(:,:,jnz)=zfield(:,:) 
    1230  
    1231       END DO                          !! End Loop over k dimension 
    1232  
    1233       DEALLOCATE ( zslmec1 ) 
    1234       DEALLOCATE ( zfieldn ) 
    1235       DEALLOCATE ( zfield ) 
    1236  
     1206         ! 
     1207         CALL seaoverland( zfieldn, itmpi, itmpj, zfield ) 
     1208         DO jc = 1, nn_lsm 
     1209            CALL seaoverland( zfield, itmpi, itmpj, zfield ) 
     1210         END DO 
     1211         ! 
     1212         !   Check for Undeff and substitute original values 
     1213         IF( ANY(zfield==undeff_lsm) ) THEN 
     1214            DO jni = 1, itmpi 
     1215               DO jnj = 1, itmpj 
     1216                  IF( zfield(jni,jnj)==undeff_lsm )   zfield(jni,jnj) = zfieldo(jni,jnj,jnz) 
     1217               END DO 
     1218            END DO 
     1219         ENDIF 
     1220         ! 
     1221         zfieldo(:,:,jnz) = zfield(:,:) 
     1222         ! 
     1223      END DO                           !! End Loop over k dimension 
     1224      ! 
     1225      DEALLOCATE ( zslmec1, zfieldn, zfield ) 
     1226      ! 
    12371227   END SUBROUTINE apply_seaoverland  
    12381228 
    12391229 
    1240    SUBROUTINE seaoverland(zfieldn,ileni,ilenj,zfield) 
     1230   SUBROUTINE seaoverland( zfieldn, ileni, ilenj, zfield ) 
    12411231      !!--------------------------------------------------------------------- 
    12421232      !!                    ***  ROUTINE seaoverland  *** 
     
    12451235      !!      D. Delrosso INGV 
    12461236      !!----------------------------------------------------------------------  
    1247       INTEGER,INTENT(in)                       :: ileni,ilenj              ! lengths  
    1248       REAL,DIMENSION (ileni,ilenj),INTENT(in)  :: zfieldn                  ! array of forcing field with undeff for land points 
    1249       REAL,DIMENSION (ileni,ilenj),INTENT(out) :: zfield                   ! array of forcing field 
    1250       REAL,DIMENSION (ileni,ilenj)             :: zmat1,zmat2,zmat3,zmat4  ! temporary arrays for seaoverland application 
    1251       REAL,DIMENSION (ileni,ilenj)             :: zmat5,zmat6,zmat7,zmat8  ! temporary arrays for seaoverland application 
    1252       REAL,DIMENSION (ileni,ilenj)             :: zlsm2d                   ! temporary arrays for seaoverland application 
    1253       REAL,DIMENSION (ileni,ilenj,8)           :: zlsm3d                   ! temporary arrays for seaoverland application 
    1254       LOGICAL,DIMENSION (ileni,ilenj,8)        :: ll_msknan3d              ! logical mask for undeff detection 
    1255       LOGICAL,DIMENSION (ileni,ilenj)          :: ll_msknan2d              ! logical mask for undeff detection 
     1237      INTEGER                      , INTENT(in   ) :: ileni,ilenj   ! lengths  
     1238      REAL, DIMENSION (ileni,ilenj), INTENT(in   ) :: zfieldn       ! array of forcing field with undeff for land points 
     1239      REAL, DIMENSION (ileni,ilenj), INTENT(  out) :: zfield        ! array of forcing field 
     1240      ! 
     1241      REAL   , DIMENSION (ileni,ilenj)   :: zmat1, zmat2, zmat3, zmat4  ! local arrays  
     1242      REAL   , DIMENSION (ileni,ilenj)   :: zmat5, zmat6, zmat7, zmat8  !   -     -  
     1243      REAL   , DIMENSION (ileni,ilenj)   :: zlsm2d                      !   -     -  
     1244      REAL   , DIMENSION (ileni,ilenj,8) :: zlsm3d                      !   -     - 
     1245      LOGICAL, DIMENSION (ileni,ilenj,8) :: ll_msknan3d                 ! logical mask for undeff detection 
     1246      LOGICAL, DIMENSION (ileni,ilenj)   :: ll_msknan2d                 ! logical mask for undeff detection 
    12561247      !!----------------------------------------------------------------------  
    1257       zmat8 = eoshift(zfieldn   ,  SHIFT=-1, BOUNDARY = (/zfieldn(:,1)/)    ,DIM=2) 
    1258       zmat1 = eoshift(zmat8     ,  SHIFT=-1, BOUNDARY = (/zmat8(1,:)/)      ,DIM=1) 
    1259       zmat2 = eoshift(zfieldn   ,  SHIFT=-1, BOUNDARY = (/zfieldn(1,:)/)    ,DIM=1) 
    1260       zmat4 = eoshift(zfieldn   ,  SHIFT= 1, BOUNDARY = (/zfieldn(:,ilenj)/),DIM=2) 
    1261       zmat3 = eoshift(zmat4     ,  SHIFT=-1, BOUNDARY = (/zmat4(1,:)/)      ,DIM=1) 
    1262       zmat5 = eoshift(zmat4     ,  SHIFT= 1, BOUNDARY = (/zmat4(ileni,:)/)  ,DIM=1) 
    1263       zmat6 = eoshift(zfieldn   ,  SHIFT= 1, BOUNDARY = (/zfieldn(ileni,:)/),DIM=1) 
    1264       zmat7 = eoshift(zmat8     ,  SHIFT= 1, BOUNDARY = (/zmat8(ileni,:)/)  ,DIM=1) 
    1265  
     1248      zmat8 = eoshift( zfieldn , SHIFT=-1 , BOUNDARY = (/zfieldn(:,1)/)     , DIM=2 ) 
     1249      zmat1 = eoshift( zmat8   , SHIFT=-1 , BOUNDARY = (/zmat8(1,:)/)       , DIM=1 ) 
     1250      zmat2 = eoshift( zfieldn , SHIFT=-1 , BOUNDARY = (/zfieldn(1,:)/)     , DIM=1 ) 
     1251      zmat4 = eoshift( zfieldn , SHIFT= 1 , BOUNDARY = (/zfieldn(:,ilenj)/) , DIM=2 ) 
     1252      zmat3 = eoshift( zmat4   , SHIFT=-1 , BOUNDARY = (/zmat4(1,:)/)       , DIM=1 ) 
     1253      zmat5 = eoshift( zmat4   , SHIFT= 1 , BOUNDARY = (/zmat4(ileni,:)/)   , DIM=1 ) 
     1254      zmat6 = eoshift( zfieldn , SHIFT= 1 , BOUNDARY = (/zfieldn(ileni,:)/) , DIM=1 ) 
     1255      zmat7 = eoshift( zmat8   , SHIFT= 1 , BOUNDARY = (/zmat8(ileni,:)/)   , DIM=1 ) 
     1256      ! 
    12661257      zlsm3d  = RESHAPE( (/ zmat1, zmat2, zmat3, zmat4, zmat5, zmat6, zmat7, zmat8 /), (/ ileni, ilenj, 8 /)) 
    1267       ll_msknan3d = .not.(zlsm3d==undeff_lsm) 
    1268       ll_msknan2d = .not.(zfieldn==undeff_lsm)  ! FALSE where is Undeff (land) 
    1269       zlsm2d = (SUM ( zlsm3d, 3 , ll_msknan3d ) )/(MAX(1,(COUNT( ll_msknan3d , 3 ))   )) 
    1270       WHERE ((COUNT( ll_msknan3d , 3 )) == 0.0_wp)  zlsm2d = undeff_lsm 
    1271       zfield = MERGE (zfieldn,zlsm2d,ll_msknan2d) 
     1258      ll_msknan3d = .NOT.( zlsm3d  == undeff_lsm ) 
     1259      ll_msknan2d = .NOT.( zfieldn == undeff_lsm )  ! FALSE where is Undeff (land) 
     1260      zlsm2d = SUM( zlsm3d, 3 , ll_msknan3d ) / MAX( 1 , COUNT( ll_msknan3d , 3 ) ) 
     1261      WHERE( COUNT( ll_msknan3d , 3 ) == 0._wp )   zlsm2d = undeff_lsm 
     1262      zfield = MERGE( zfieldn, zlsm2d, ll_msknan2d ) 
     1263      ! 
    12721264   END SUBROUTINE seaoverland 
    12731265 
     
    12881280      INTEGER                   , INTENT(in   ) ::   nrec    ! record number to read (ie time slice) 
    12891281      CHARACTER(LEN=*)          , INTENT(in   ) ::   lsmfile ! land sea mask file name 
    1290       !!  
    1291       REAL(wp),DIMENSION(:,:,:),ALLOCATABLE     ::   ztmp_fly_dta,zfieldo                  ! temporary array of values on input grid 
    1292       INTEGER, DIMENSION(3)                     ::   rec1,recn                             ! temporary arrays for start and length 
    1293       INTEGER, DIMENSION(3)                     ::   rec1_lsm,recn_lsm                     ! temporary arrays for start and length in case of seaoverland 
    1294       INTEGER                                   ::   ii_lsm1,ii_lsm2,ij_lsm1,ij_lsm2       ! temporary indices 
    1295       INTEGER                                   ::   jk, jn, jm, jir, jjr                  ! loop counters 
    1296       INTEGER                                   ::   ni, nj                                ! lengths 
    1297       INTEGER                                   ::   jpimin,jpiwid                         ! temporary indices 
    1298       INTEGER                                   ::   jpimin_lsm,jpiwid_lsm                 ! temporary indices 
    1299       INTEGER                                   ::   jpjmin,jpjwid                         ! temporary indices 
    1300       INTEGER                                   ::   jpjmin_lsm,jpjwid_lsm                 ! temporary indices 
    1301       INTEGER                                   ::   jpi1,jpi2,jpj1,jpj2                   ! temporary indices 
    1302       INTEGER                                   ::   jpi1_lsm,jpi2_lsm,jpj1_lsm,jpj2_lsm   ! temporary indices 
    1303       INTEGER                                   ::   itmpi,itmpj,itmpz                     ! lengths 
    1304        
     1282      ! 
     1283      INTEGER, DIMENSION(3) ::   rec1, recn           ! temporary arrays for start and length 
     1284      INTEGER, DIMENSION(3) ::   rec1_lsm, recn_lsm   ! temporary arrays for start and length in case of seaoverland 
     1285      INTEGER ::   ii_lsm1,ii_lsm2,ij_lsm1,ij_lsm2    ! temporary indices 
     1286      INTEGER ::   jk, jn, jm, jir, jjr               ! loop counters 
     1287      INTEGER ::   ni, nj                             ! lengths 
     1288      INTEGER ::   jpimin,jpiwid                      ! temporary indices 
     1289      INTEGER ::   jpimin_lsm,jpiwid_lsm              ! temporary indices 
     1290      INTEGER ::   jpjmin,jpjwid                      ! temporary indices 
     1291      INTEGER ::   jpjmin_lsm,jpjwid_lsm              ! temporary indices 
     1292      INTEGER ::   jpi1,jpi2,jpj1,jpj2                ! temporary indices 
     1293      INTEGER ::   jpi1_lsm,jpi2_lsm,jpj1_lsm,jpj2_lsm   ! temporary indices 
     1294      INTEGER ::   itmpi,itmpj,itmpz                     ! lengths 
     1295      REAL(wp),DIMENSION(:,:,:), ALLOCATABLE ::   ztmp_fly_dta                 ! local array of values on input grid      
    13051296      !!---------------------------------------------------------------------- 
    13061297      ! 
     
    13551346 
    13561347 
    1357          itmpi=SIZE(ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),1) 
    1358          itmpj=SIZE(ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),2) 
     1348         itmpi=jpi2_lsm-jpi1_lsm+1 
     1349         itmpj=jpj2_lsm-jpj1_lsm+1 
    13591350         itmpz=kk 
    13601351         ALLOCATE(ztmp_fly_dta(itmpi,itmpj,itmpz)) 
Note: See TracChangeset for help on using the changeset viewer.