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 15180 for NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_surf_def.F90 – NEMO

Ignore:
Timestamp:
2021-08-11T13:24:27+02:00 (3 years ago)
Author:
dford
Message:

Further generification, particularly surrounding additional and extra variables.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_surf_def.F90

    r14075 r15180  
    2323   USE obs_mpp, ONLY : &  ! MPP tools  
    2424      obs_mpp_sum_integer 
     25   USE obs_fbm            ! Obs feedback format 
    2526 
    2627   IMPLICIT NONE 
    … …  
    4546      INTEGER :: nsurfmpp   !: Global number of surface data within window 
    4647      INTEGER :: nvar       !: Number of variables at observation points 
     48      INTEGER :: nadd       !: Number of additional fields at observation points 
    4749      INTEGER :: nextra     !: Number of extra fields at observation points 
    4850      INTEGER :: nstp       !: Number of time steps 
    … …  
    6971         & ntyp           !: Type of surface observation product 
    7072 
    71       CHARACTER(len=8), POINTER, DIMENSION(:) :: & 
    72          & cvars          !: Variable names 
    73  
    74       CHARACTER(LEN=8), POINTER, DIMENSION(:) :: & 
     73      CHARACTER(len=ilenname), POINTER, DIMENSION(:) :: & 
     74         & cvars,    &    !: Variable names 
     75         & cextvars, &    !: Extra variable names 
     76         & caddvars       !: Additional variable names 
     77 
     78      CHARACTER(len=ilenlong), POINTER, DIMENSION(:) :: & 
     79         & clong,    &    !: Variable long names 
     80         & cextlong       !: Extra variable long names 
     81 
     82      CHARACTER(len=ilenlong), POINTER, DIMENSION(:,:) :: & 
     83         & caddlong       !: Additional variable long names 
     84 
     85      CHARACTER(len=ilenunit), POINTER, DIMENSION(:) :: & 
     86         & cunit,    &    !: Variable units 
     87         & cextunit       !: Extra variable units 
     88 
     89      CHARACTER(len=ilenunit), POINTER, DIMENSION(:,:) :: & 
     90         & caddunit       !: Additional variable units 
     91 
     92      CHARACTER(len=ilengrid), POINTER, DIMENSION(:) :: & 
     93         & cgrid          !: Variable grids 
     94 
     95      CHARACTER(LEN=ilenwmo), POINTER, DIMENSION(:) :: & 
    7596         & cwmo           !: WMO indentifier 
    7697          
    … …  
    86107         & rext           !: Extra fields interpolated to observation points 
    87108 
    88       REAL(KIND=wp), POINTER, DIMENSION(:,:) :: & 
     109      REAL(KIND=wp), POINTER, DIMENSION(:,:,:) :: & 
     110         & radd           !: Additional fields interpolated to observation points 
     111 
     112      REAL(KIND=wp), POINTER, DIMENSION(:,:,:) :: & 
    89113         & vdmean         !: Time averaged of model field 
    90114 
    … …  
    121145CONTAINS 
    122146    
    123    SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kextra, kstp, kpi, kpj ) 
     147   SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kadd, kextra, kstp, kpi, kpj ) 
    124148      !!---------------------------------------------------------------------- 
    125149      !!                     ***  ROUTINE obs_surf_alloc  *** 
    … …  
    136160      INTEGER, INTENT(IN) :: ksurf   ! Number of surface observations 
    137161      INTEGER, INTENT(IN) :: kvar    ! Number of surface variables 
     162      INTEGER, INTENT(IN) :: kadd    ! Number of additional fields at observation points 
    138163      INTEGER, INTENT(IN) :: kextra  ! Number of extra fields at observation points 
    139164      INTEGER, INTENT(IN) :: kstp    ! Number of time steps 
    … …  
    143168      !!* Local variables 
    144169      INTEGER :: ji 
    145       INTEGER :: jvar 
     170      INTEGER :: jvar, jadd, jext 
    146171 
    147172      ! Set bookkeeping variables 
    … …  
    149174      surf%nsurf    = ksurf 
    150175      surf%nsurfmpp = 0 
     176      surf%nadd     = kadd 
    151177      surf%nextra   = kextra 
    152178      surf%nvar     = kvar 
    … …  
    158184 
    159185      ALLOCATE( & 
    160          & surf%cvars(kvar)    & 
     186         & surf%cvars(kvar), & 
     187         & surf%clong(kvar), & 
     188         & surf%cunit(kvar), & 
     189         & surf%cgrid(kvar)  & 
    161190         & ) 
    162191 
    163192      DO jvar = 1, kvar 
    164193         surf%cvars(jvar) = "NotSet" 
     194         surf%clong(jvar) = "NotSet" 
     195         surf%cunit(jvar) = "NotSet" 
     196         surf%cgrid(jvar) = "" 
     197      END DO 
     198 
     199      ! Allocate additional/extra variable metadata 
     200 
     201      ALLOCATE( & 
     202         & surf%caddvars(kadd),      & 
     203         & surf%caddlong(kadd,kvar), & 
     204         & surf%caddunit(kadd,kvar), & 
     205         & surf%cextvars(kextra),    & 
     206         & surf%cextlong(kextra),    & 
     207         & surf%cextunit(kextra)     & 
     208         ) 
     209          
     210      DO jadd = 1, kadd 
     211         surf%caddvars(jadd) = "NotSet" 
     212         DO jvar = 1, kvar 
     213            surf%caddlong(jadd,jvar) = "NotSet" 
     214            surf%caddunit(jadd,jvar) = "NotSet" 
     215         END DO 
     216      END DO 
     217          
     218      DO jext = 1, kextra 
     219         surf%cextvars(jext) = "NotSet" 
     220         surf%cextlong(jext) = "NotSet" 
     221         surf%cextunit(jext) = "NotSet" 
    165222      END DO 
    166223       
    … …  
    205262      surf%rext(:,:) = 0.0_wp  
    206263 
     264      ! Allocate arrays of number of additional fields at observation points 
     265 
     266      ALLOCATE( &  
     267         & surf%radd(ksurf,kadd,kvar) & 
     268         & ) 
     269 
     270      surf%radd(:,:,:) = 0.0_wp  
     271 
    207272      ! Allocate arrays of number of time step size 
    208273 
    … …  
    215280 
    216281      ALLOCATE( & 
    217          & surf%vdmean(kpi,kpj) & 
     282         & surf%vdmean(kpi,kpj,kvar) & 
    218283         & ) 
    219284 
    … …  
    291356         & ) 
    292357 
     358      ! Deallocate arrays of number of additional fields at observation points 
     359 
     360      DEALLOCATE( &  
     361         & surf%radd & 
     362         & ) 
     363 
    293364      ! Deallocate arrays of size number of grid points size times 
    294365      ! number of variables 
    … …  
    308379 
    309380      DEALLOCATE( & 
    310          & surf%cvars     & 
    311          & ) 
     381         & surf%cvars, & 
     382         & surf%clong, & 
     383         & surf%cunit, & 
     384         & surf%cgrid  & 
     385         & ) 
     386 
     387      ! Dellocate additional/extra variables metadata 
     388 
     389      DEALLOCATE( & 
     390         & surf%caddvars, & 
     391         & surf%caddlong, & 
     392         & surf%caddunit, & 
     393         & surf%cextvars, & 
     394         & surf%cextlong, & 
     395         & surf%cextunit  & 
     396         ) 
    312397 
    313398   END SUBROUTINE obs_surf_dealloc 
    … …  
    343428      INTEGER :: ji 
    344429      INTEGER :: jk 
     430      INTEGER :: jadd 
    345431      LOGICAL, DIMENSION(:), ALLOCATABLE :: llvalid 
    346432 
    … …  
    361447 
    362448      IF ( lallocate ) THEN 
    363          CALL obs_surf_alloc( newsurf,  insurf, surf%nvar, & 
     449         CALL obs_surf_alloc( newsurf,  insurf, surf%nvar, surf%nadd, & 
    364450            & surf%nextra, surf%nstp, surf%npi, surf%npj ) 
    365451      ENDIF 
    … …  
    410496               newsurf%rmod(insurf,jk)  = surf%rmod(ji,jk) 
    411497                
     498               DO jadd = 1, surf%nadd 
     499                  newsurf%radd(insurf,jadd,jk) = surf%radd(ji,jadd,jk) 
     500               END DO 
     501                
    412502            END DO 
    413503 
    … …  
    435525      newsurf%nstp     = surf%nstp 
    436526      newsurf%cvars(:) = surf%cvars(:) 
     527      newsurf%clong(:) = surf%clong(:) 
     528      newsurf%cunit(:) = surf%cunit(:) 
     529      newsurf%cgrid(:) = surf%cgrid(:) 
     530      newsurf%caddvars(:) = surf%caddvars(:) 
     531      newsurf%caddlong(:) = surf%caddlong(:) 
     532      newsurf%caddunit(:) = surf%caddunit(:) 
     533      newsurf%cextvars(:) = surf%cextvars(:) 
     534      newsurf%cextlong(:) = surf%cextlong(:) 
     535      newsurf%cextunit(:) = surf%cextunit(:) 
    437536       
    438537      ! Set gridded stuff 
    … …  
    470569      INTEGER :: jj 
    471570      INTEGER :: jk 
     571      INTEGER :: jadd 
    472572 
    473573      ! Copy data from surf to old surf 
    … …  
    504604            oldsurf%robs(jj,jk)  = surf%robs(ji,jk) 
    505605            oldsurf%rmod(jj,jk)  = surf%rmod(ji,jk) 
     606                
     607            DO jadd = 1, surf%nadd 
     608               oldsurf%radd(jj,jadd,jk) = surf%radd(ji,jadd,jk) 
     609            END DO 
    506610 
    507611         END DO 
Note: See TracChangeset for help on using the changeset viewer.