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 5682 for branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90 – NEMO

Ignore:
Timestamp:
2015-08-12T17:46:45+02:00 (9 years ago)
Author:
mattmartin
Message:

OBS simplification changes committed to branch after running SETTE tests to make sure we get the same results as the trunk for ORCA2_LIM_OBS.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90

    r5659 r5682  
    99   !!---------------------------------------------------------------------- 
    1010 
    11    !! * Modules used    
     11   !! * Modules used 
    1212   USE par_kind                 ! Precision variables 
    1313   USE in_out_manager           ! I/O manager 
     
    2020   USE obs_surf_def             ! Surface observation definitions 
    2121   USE obs_types                ! Observation type definitions 
     22   USE obs_fbm                  ! Feedback routines 
    2223   USE netcdf                   ! NetCDF library 
    2324 
     
    2829 
    2930   PUBLIC obs_rea_surf      ! Read the surface observations from the point data 
    30     
     31 
    3132   !!---------------------------------------------------------------------- 
    3233   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    3738CONTAINS 
    3839 
    39    SUBROUTINE obs_rea_surf( surfdata, knumfiles, cfilenames, & 
     40   SUBROUTINE obs_rea_surf( surfdata, knumfiles, cdfilenames, & 
    4041      &                     kvars, kextr, kstp, ddobsini, ddobsend, & 
    41       &                     ldignmis, ldmod ) 
     42      &                     ldignmis, ldmod, ldnightav ) 
    4243      !!--------------------------------------------------------------------- 
    4344      !! 
     
    5960 
    6061      !! * Arguments 
    61       TYPE(obs_surf), INTENT(INOUT) :: surfdata   ! Surface data to be read 
    62       INTEGER, INTENT(IN) :: knumfiles    ! Number of corio format files to read in 
    63       CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in 
     62      TYPE(obs_surf), INTENT(INOUT) :: & 
     63         & surfdata                     ! Surface data to be read 
     64      INTEGER, INTENT(IN) :: knumfiles  ! Number of corio format files to read 
     65      CHARACTER(LEN=128), INTENT(IN) :: & 
     66         & cdfilenames(knumfiles)       ! File names to read in 
    6467      INTEGER, INTENT(IN) :: kvars      ! Number of variables in surfdata 
    65       INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var in surfdata 
     68      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var 
    6669      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index 
    6770      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files 
    6871      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data 
    69       REAL(KIND=dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS 
    70       REAL(KIND=dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS 
    71           
     72      LOGICAL, INTENT(IN) :: ldnightav  ! Observations represent a night-time average 
     73      REAL(dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS 
     74      REAL(dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS 
     75 
    7276      !! * Local declarations 
    7377      CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_surf' 
     78      CHARACTER(len=8) :: clrefdate 
     79      CHARACTER(len=6), DIMENSION(:), ALLOCATABLE :: clvars 
    7480      INTEGER :: ji 
    7581      INTEGER :: jj 
     
    8591      INTEGER :: imin 
    8692      INTEGER :: isec 
     93      INTEGER :: itype 
     94      INTEGER :: iobsmpp 
     95      INTEGER :: iobs 
     96      INTEGER :: iobstot 
     97      INTEGER :: ios 
     98      INTEGER :: ioserrcount 
     99      INTEGER, PARAMETER :: jpsurfmaxtype = 1024 
    87100      INTEGER, DIMENSION(knumfiles) :: irefdate 
    88       INTEGER :: iobsmpp 
    89       INTEGER, PARAMETER :: isurfmaxtype = 1024 
    90       INTEGER, DIMENSION(0:isurfmaxtype) :: & 
     101      INTEGER, DIMENSION(jpsurfmaxtype+1) :: & 
    91102         & ityp, & 
    92103         & itypmpp 
     
    98109         & ifileidx, & 
    99110         & isurfidx 
    100       INTEGER :: itype 
    101111      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    102112         & zphi, & 
    103113         & zlam 
    104       real(wp), DIMENSION(:), ALLOCATABLE :: & 
     114      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    105115         & zdat 
     116      REAL(wp), DIMENSION(knumfiles) :: & 
     117         & djulini, & 
     118         & djulend 
    106119      LOGICAL :: llvalprof 
    107120      TYPE(obfbdata), POINTER, DIMENSION(:) :: & 
    108121         & inpfiles 
    109       real(wp), DIMENSION(knumfiles) :: & 
    110          & djulini, & 
    111          & djulend 
    112       INTEGER :: iobs 
    113       INTEGER :: iobstot 
    114       INTEGER :: ios 
    115       INTEGER :: ioserrcount 
    116       CHARACTER(len=8) :: cl_refdate 
    117     
     122 
    118123      ! Local initialization 
    119124      iobs = 0 
    120   
    121       !----------------------------------------------------------------------- 
    122       ! Check data the model part is just with feedback data files 
    123       !----------------------------------------------------------------------- 
    124       IF ( ldmod .AND. ( kformat /= 0 ) ) THEN 
    125          CALL ctl_stop( 'Model can only be read from feedback data' ) 
    126          RETURN 
    127       ENDIF 
    128125 
    129126      !----------------------------------------------------------------------- 
    130127      ! Count the number of files needed and allocate the obfbdata type 
    131128      !----------------------------------------------------------------------- 
    132        
     129 
    133130      inobf = knumfiles 
    134        
     131 
    135132      ALLOCATE( inpfiles(inobf) ) 
    136133 
    137134      surf_files : DO jj = 1, inobf 
    138135 
    139          CALL init_obfbdata( inpfiles(jj) ) 
    140            
    141136         !--------------------------------------------------------------------- 
    142137         ! Prints 
     
    145140            WRITE(numout,*) 
    146141            WRITE(numout,*) ' obs_rea_surf : Reading from file = ', & 
    147                & TRIM( TRIM( cfilenames(jj) ) ) 
     142               & TRIM( TRIM( cdfilenames(jj) ) ) 
    148143            WRITE(numout,*) ' ~~~~~~~~~~~' 
    149144            WRITE(numout,*) 
     
    153148         !  Initialization: Open file and get dimensions only 
    154149         !--------------------------------------------------------------------- 
    155           
    156          iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, & 
     150 
     151         iflag = nf90_open( TRIM( TRIM( cdfilenames(jj) ) ), nf90_nowrite, & 
    157152            &                      i_file_id ) 
    158           
     153 
    159154         IF ( iflag /= nf90_noerr ) THEN 
    160155 
    161156            IF ( ldignmis ) THEN 
    162157               inpfiles(jj)%nobs = 0 
    163                CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // & 
     158               CALL ctl_warn( 'File ' // TRIM( TRIM( cdfilenames(jj) ) ) // & 
    164159                  &           ' not found' ) 
    165160            ELSE  
    166                CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // & 
     161               CALL ctl_stop( 'File ' // TRIM( TRIM( cdfilenames(jj) ) ) // & 
    167162                  &           ' not found' ) 
    168163            ENDIF 
    169164 
    170165         ELSE  
    171              
    172             !------------------------------------------------------------------ 
    173             !  Close the file since it is opened in read_proffile 
    174             !------------------------------------------------------------------ 
    175              
     166 
     167            !------------------------------------------------------------------ 
     168            !  Close the file since it is opened in read_obfbdata 
     169            !------------------------------------------------------------------ 
     170 
    176171            iflag = nf90_close( i_file_id ) 
    177172 
     
    179174            !  Read the profile file into inpfiles 
    180175            !------------------------------------------------------------------ 
    181             IF(lwp) THEN 
    182                WRITE(numout,*) 
    183                WRITE(numout,*)'Reading from feedback file :', & 
    184                   &           TRIM( cfilenames(jj) ) 
    185             ENDIF 
    186             CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), & 
     176            CALL init_obfbdata( inpfiles(jj) ) 
     177            CALL read_obfbdata( TRIM( cdfilenames(jj) ), inpfiles(jj), & 
    187178               &                ldgrid = .TRUE. ) 
     179 
    188180            IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN 
    189181               CALL ctl_stop( 'Model not in input data' ) 
     
    191183            ENDIF 
    192184 
     185            IF ( jj == 1 ) THEN 
     186               ALLOCATE( clvars( inpfiles(jj)%nvar ) ) 
     187               DO ji = 1, inpfiles(jj)%nvar 
     188                 clvars(ji) = inpfiles(jj)%cname(ji) 
     189               END DO 
     190            ELSE 
     191               DO ji = 1, inpfiles(jj)%nvar 
     192                  IF ( inpfiles(jj)%cname(ji) /= clvars(ji) ) THEN 
     193                     CALL ctl_stop( 'Feedback file variables not consistent', & 
     194                        &           ' with previous files for this type' ) 
     195                  ENDIF 
     196               END DO 
     197            ENDIF 
     198 
    193199            !------------------------------------------------------------------ 
    194200            !  Change longitude (-180,180) 
    195201            !------------------------------------------------------------------ 
    196202 
    197             DO ji = 1, inpfiles(jj)%nobs  
     203            DO ji = 1, inpfiles(jj)%nobs 
    198204 
    199205               IF ( inpfiles(jj)%plam(ji) < -180. ) & 
     
    208214            !  Calculate the date  (change eventually) 
    209215            !------------------------------------------------------------------ 
    210             cl_refdate=inpfiles(jj)%cdjuldref(1:8) 
    211             READ(cl_refdate,'(I8)') irefdate(jj) 
    212              
     216            clrefdate=inpfiles(jj)%cdjuldref(1:8) 
     217            READ(clrefdate,'(I8)') irefdate(jj) 
     218 
    213219            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec ) 
    214220            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), & 
     
    217223            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), & 
    218224               &           krefdate = irefdate(jj) ) 
     225 
     226            IF ( ldnightav ) THEN 
     227 
     228               IF ( lwp ) THEN 
     229                  WRITE(numout,*)'Resetting time of night-time averaged observations', & 
     230                     &             ' to the end of the day' 
     231               ENDIF 
     232 
     233               DO ji = 1, inpfiles(jj)%nobs 
     234                  !  for night-time averaged data force the time 
     235                  !  to be the last time-step of the day, but still within the day. 
     236                  IF ( inpfiles(jj)%ptim(ji) >= 0. ) THEN 
     237                     inpfiles(jj)%ptim(ji) = & 
     238                        & INT(inpfiles(jj)%ptim(ji)) + 0.9999 
     239                  ELSE 
     240                     inpfiles(jj)%ptim(ji) = & 
     241                        & INT(inpfiles(jj)%ptim(ji)) - 0.0001 
     242                  ENDIF 
     243               END DO 
     244            ENDIF 
     245 
    219246            IF ( inpfiles(jj)%nobs > 0 ) THEN 
    220247               inpfiles(jj)%iproc = -1 
     
    312339         &               zdat,     & 
    313340         &               iindx   ) 
    314        
     341 
    315342      CALL obs_surf_alloc( surfdata, iobs, kvars, kextr, kstp, jpi, jpj ) 
    316        
    317       ! * Read obs/positions, QC, all variable and assign to surfdata 
    318   
     343 
     344      ! Read obs/positions, QC, all variable and assign to surfdata 
     345 
    319346      iobs = 0 
     347 
     348      surfdata%cvars(:)  = clvars(:) 
    320349 
    321350      ityp   (:) = 0 
    322351      itypmpp(:) = 0 
    323        
     352 
    324353      ioserrcount = 0 
    325        
     354 
    326355      DO jk = 1, iobstot 
    327           
     356 
    328357         jj = ifileidx(iindx(jk)) 
    329358         ji = isurfidx(iindx(jk)) 
    330359         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  & 
    331360            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN 
    332              
     361 
    333362            IF ( nproc == 0 ) THEN 
    334363               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE 
     
    336365               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE 
    337366            ENDIF 
    338              
     367 
    339368            ! Set observation information 
    340              
     369 
    341370            IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. & 
    342371               & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN 
     
    360389               surfdata%nhou(iobs) = ihou 
    361390               surfdata%nmin(iobs) = imin 
    362                 
     391 
    363392               ! Surface space coordinates 
    364393               surfdata%rlam(iobs) = inpfiles(jj)%plam(ji) 
     
    368397               surfdata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1) 
    369398               surfdata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1) 
    370                 
     399 
    371400               ! Instrument type 
    372401               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype 
    373402901            IF ( ios /= 0 ) THEN 
    374                   IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' )  
     403                  IF (ioserrcount == 0) THEN 
     404                     CALL ctl_warn ( 'Problem converting an instrument type ', & 
     405                        &            'to integer. Setting type to zero' ) 
     406                  ENDIF 
    375407                  ioserrcount = ioserrcount + 1 
    376408                  itype = 0 
    377409               ENDIF 
    378410               surfdata%ntyp(iobs) = itype 
    379                IF ( itype < isurfmaxtype + 1 ) THEN 
     411               IF ( itype < jpsurfmaxtype + 1 ) THEN 
    380412                  ityp(itype+1) = ityp(itype+1) + 1 
    381413               ELSE 
    382                   IF(lwp)WRITE(numout,*)'WARNING:Increase isurfmaxtype in ',& 
     414                  IF(lwp)WRITE(numout,*)'WARNING:Increase jpsurfmaxtype in ',& 
    383415                     &                  cpname 
    384416               ENDIF 
     
    398430               IF ( ldmod ) THEN 
    399431                  surfdata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1) 
    400                ELSE 
     432                  IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) THEN 
     433                     surfdata%rext(iobs,1) = inpfiles(jj)%padd(1,ji,2,1) 
     434                     surfdata%rext(iobs,2) = inpfiles(jj)%pext(1,ji,1) 
     435                  ENDIF 
     436                ELSE 
    401437                  surfdata%rmod(iobs,1) = fbrmdi 
     438                  IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) surfdata%rext(iobs,:) = fbrmdi 
    402439               ENDIF 
    403440            ENDIF 
     
    409446      ! Sum up over processors 
    410447      !----------------------------------------------------------------------- 
    411        
     448 
    412449      CALL obs_mpp_sum_integer( iobs, iobsmpp ) 
    413        
     450      CALL obs_mpp_sum_integers( ityp, itypmpp, jpsurfmaxtype + 1 ) 
     451 
    414452      !----------------------------------------------------------------------- 
    415453      ! Output number of observations. 
     
    418456 
    419457         WRITE(numout,*) 
    420          WRITE(numout,'(1X,A)')'Surface data types' 
     458         WRITE(numout,'(1X,A)')TRIM( surfdata%cvars(1) )//' data' 
    421459         WRITE(numout,'(1X,A)')'--------------' 
    422460         DO jj = 1,8 
     
    425463            ENDIF 
    426464         END DO 
    427          WRITE(numout,'(1X,A50)')'--------------------------------------------------' 
    428          WRITE(numout,'(1X,A40,I10)')'Total                                 = ',iobsmpp 
     465         WRITE(numout,'(1X,A)') & 
     466            & '---------------------------------------------------------------' 
     467         WRITE(numout,'(1X,A,I8)') & 
     468            & 'Total data for variable '//TRIM( surfdata%cvars(1) )// & 
     469            & '           = ', iobsmpp 
     470         WRITE(numout,'(1X,A)') & 
     471            & '---------------------------------------------------------------' 
    429472         WRITE(numout,*) 
    430473 
     
    434477      ! Deallocate temporary data 
    435478      !----------------------------------------------------------------------- 
    436       DEALLOCATE( ifileidx, isurfidx, zdat ) 
     479      DEALLOCATE( ifileidx, isurfidx, zdat, clvars ) 
    437480 
    438481      !----------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.