Changeset 11468 for branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

Timestamp:

2019-08-23T10:37:22+02:00 (5 years ago)

Author:

mattmartin

Message:

Merged changes to allow writing of climatological information to feedback files.

File:

• branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90 (modified) (21 diffs)

branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

@@ -33 +33 @@
    USE mpp_map                  ! MPP mapping
    USE lib_mpp                  ! For ctl_warn/stop
+   USE tradmp                   ! For climatological temperature & salinity
 
    IMPLICIT NONE
@@ -53 +54 @@
    LOGICAL :: ln_sss_fp_indegs     !: T=>     SSS obs footprint size specified in degrees, F=> in metres
    LOGICAL :: ln_sic_fp_indegs     !: T=> sea-ice obs footprint size specified in degrees, F=> in metres
+   LOGICAL :: ln_output_clim       !: Logical switch for interpolating and writing T/S climatology
 
    REAL(wp) :: rn_default_avglamscl !: Default E/W diameter of observation footprint
@@ -232 +234 @@
       LOGICAL :: ltype_fp_indegs ! Local version of ln_*_fp_indegs
       LOGICAL :: ltype_night     ! Local version of ln_sstnight (false for other variables)
+      LOGICAL :: ltype_clim      ! Local version of ln_output_clim
 
       REAL(wp), POINTER, DIMENSION(:,:,:) :: &
@@ -254 +257 @@
          &            ln_grid_global, ln_grid_search_lookup,          &
          &            ln_ignmis, ln_s_at_t, ln_bound_reject,          &
-         &            ln_sstnight, ln_default_fp_indegs,              &
+         &            ln_sstnight,  ln_output_clim,                   &
+         &            ln_default_fp_indegs,                           &
          &            ln_sla_fp_indegs, ln_sst_fp_indegs,             &
          &            ln_sss_fp_indegs, ln_sic_fp_indegs,             &
@@ -415 +419 @@
          WRITE(numout,*) '             Daily average types                             nn_profdavtypes = ', nn_profdavtypes
          WRITE(numout,*) '             Logical switch for night-time SST obs               ln_sstnight = ', ln_sstnight
+         WRITE(numout,*) '             Logical switch for writing climat. at obs points ln_output_clim = ', ln_output_clim
       ENDIF
       !-----------------------------------------------------------------------
@@ -438 +443 @@
          RETURN
       ENDIF
+
+      IF ( ln_output_clim .AND. ( .NOT. ln_tradmp ) ) THEN
+         IF(lwp) WRITE(numout,cform_war)
+         IF(lwp) WRITE(numout,*) ' ln_output_clim is true, but ln_tradmp is false', &
+            &                    ' so climatological T/S not available and will not be output'
+         nwarn = nwarn + 1
+         ln_output_clim = .FALSE.
+      ENDIF
+     
 
       IF(lwp) WRITE(numout,*) '          Number of profile obs types: ',nproftypes
@@ -714 +728 @@
 
          DO jtype = 1, nproftypes
-
+            
+            ltype_clim = .FALSE. 
+            
             IF ( TRIM(cobstypesprof(jtype)) == 'prof' ) THEN
                nvarsprof(jtype) = 2
                nextrprof(jtype) = 1
+               IF ( ln_output_clim ) ltype_clim = .TRUE.              
                ALLOCATE(llvar(nvarsprof(jtype)))
                CALL wrk_alloc( jpi, jpj,      nvarsprof(jtype), zglam )
@@ -763 +780 @@
                &               nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, &
                &               rn_dobsini, rn_dobsend, llvar, &
-               &               ln_ignmis, ln_s_at_t, .FALSE., &
+               &               ln_ignmis, ln_s_at_t, .FALSE., ltype_clim, &
                &               kdailyavtypes = nn_profdavtypes )
 
@@ -799 +816 @@
             nvarssurf(jtype) = 1
             nextrsurf(jtype) = 0
+            ltype_clim = .FALSE.
             IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) nextrsurf(jtype) = 2
+            IF ( ln_output_clim .AND. &
+               & ( ( TRIM(cobstypessurf(jtype)) == 'sst' ) .OR. &
+               &   ( TRIM(cobstypessurf(jtype)) == 'sss' ) ) ) &
+               & ltype_clim = .TRUE.
 
             !Read in surface obs types
@@ -805 +827 @@
                &               clsurffiles(jtype,1:ifilessurf(jtype)), &
                &               nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, &
-               &               rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav(jtype) )
+               &               rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., &
+               &               llnightav(jtype), ltype_clim )
 
             CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea, ln_bound_reject )
@@ -926 +949 @@
       REAL(wp) :: tiny             ! small number
       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: &
-         & zprofvar                ! Model values for variables in a prof ob
+         & zprofvar, &             ! Model values for variables in a prof ob
+         & zprofclim               ! Climatology values for variables in a prof ob
       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: &
          & zprofmask               ! Mask associated with zprofvar
       REAL(wp), POINTER, DIMENSION(:,:) :: &
          & zsurfvar, &             ! Model values equivalent to surface ob.
+         & zsurfclim, &            ! Climatology values for variables in a surface ob.
          & zsurfmask               ! Mask associated with surface variable
       REAL(wp), POINTER, DIMENSION(:,:,:) :: &
@@ -940 +965 @@
          & pco2_3d                 ! 3D pCO2 from FABM
 #endif
-
+      
       IF(lwp) THEN
          WRITE(numout,*)
@@ -963 +988 @@
             CALL wrk_alloc( jpi, jpj,      profdataqc(jtype)%nvar, zglam     )
             CALL wrk_alloc( jpi, jpj,      profdataqc(jtype)%nvar, zgphi     )
-            
+            CALL wrk_alloc( jpi, jpj, jpk, profdataqc(jtype)%nvar, zprofclim )    
+                              
             ! Defaults which might change
             DO jvar = 1, profdataqc(jtype)%nvar
@@ -969 +995 @@
                zglam(:,:,jvar)       = glamt(:,:)
                zgphi(:,:,jvar)       = gphit(:,:)
+               zprofclim(:,:,:,jvar) = 0._wp
             END DO
 
@@ -976 +1003 @@
                zprofvar(:,:,:,1) = tsn(:,:,:,jp_tem)
                zprofvar(:,:,:,2) = tsn(:,:,:,jp_sal)
-
+               IF ( ln_output_clim ) THEN          
+                  zprofclim(:,:,:,1) = tclim(:,:,:)
+                  zprofclim(:,:,:,2) = sclim(:,:,:)
+               ENDIF
+               
             CASE('vel')
                zprofvar(:,:,:,1) = un(:,:,:)
@@ -1155 +1186 @@
                   &               nit000, idaystp, jvar,                   &
                   &               zprofvar(:,:,:,jvar),                    &
+                  &               zprofclim(:,:,:,jvar),                   &
                   &               fsdept(:,:,:), fsdepw(:,:,:),            & 
                   &               zprofmask(:,:,:,jvar),                   &
@@ -1166 +1198 @@
             CALL wrk_dealloc( jpi, jpj,      profdataqc(jtype)%nvar, zglam     )
             CALL wrk_dealloc( jpi, jpj,      profdataqc(jtype)%nvar, zgphi     )
+            CALL wrk_dealloc( jpi, jpj, jpk, profdataqc(jtype)%nvar, zprofclim  )            
 
          END DO
@@ -1175 +1208 @@
          !Allocate local work arrays
          CALL wrk_alloc( jpi, jpj, zsurfvar )
+         CALL wrk_alloc( jpi, jpj, zsurfclim )         
          CALL wrk_alloc( jpi, jpj, zsurfmask )
 #if defined key_fabm
@@ -1184 +1218 @@
             !Defaults which might be changed
             zsurfmask(:,:) = tmask(:,:,1)
+            zsurfclim(:,:) = 0._wp          
             llog10 = .FALSE.
 
@@ -1189 +1224 @@
             CASE('sst')
                zsurfvar(:,:) = tsn(:,:,1,jp_tem)
+               IF ( ln_output_clim ) zsurfclim(:,:) = tclim(:,:,1)
             CASE('sla')
                zsurfvar(:,:) = sshn(:,:)
             CASE('sss')
                zsurfvar(:,:) = tsn(:,:,1,jp_sal)
+               IF ( ln_output_clim ) zsurfclim(:,:) = sclim(:,:,1)              
             CASE('sic')
                IF ( kstp == 0 ) THEN
@@ -1485 +1522 @@
 
             CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj,       &
-               &               nit000, idaystp, zsurfvar, zsurfmask,    &
+               &               nit000, idaystp, zsurfvar,               &
+               &               zsurfclim, zsurfmask,                    &
                &               n2dintsurf(jtype), llnightav(jtype),     &
-               &               ravglamscl(jtype), ravgphiscl(jtype),     &
+               &               ravglamscl(jtype), ravgphiscl(jtype),    &
                &               lfpindegs(jtype) )