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 4932 for branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/NEMO/OPA_SRC – NEMO

Ignore:
Timestamp:
2014-12-01T11:08:54+01:00 (10 years ago)
Author:
acc
Message:

Branch dev_r4879_UKMO_NOC_MERGE, Check in merged UKMO_OBSASM branch; all conflicts resolved

Location:
branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/NEMO/OPA_SRC
Files:
12 edited

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90

    r3764 r4932  
    156156#if defined key_lim2 || defined key_lim3 
    157157            IF(( nn_ice == 2 ) .OR. ( nn_ice == 3 )) THEN 
    158                CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1.0 - frld(:,:)   ) 
     158          IF(ALLOCATED(frld)) THEN 
     159                  CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1.0 - frld(:,:)   ) 
     160               ELSE 
     161        CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep') 
     162          ENDIF 
    159163            ENDIF 
    160164#endif 

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r4666 r4932  
    237237         &                ' Inconsistent options') 
    238238 
    239       IF ( ( ln_bkgwri ).AND.( ( ln_asmdin ).OR.( ln_asmiau ) ) )  & 
    240          & CALL ctl_stop( ' ln_bkgwri and either ln_asmdin or ln_asmiau are set to .true.:', & 
    241          &                ' The background state must be written before applying the increments') 
    242  
    243239      IF ( ( niaufn /= 0 ).AND.( niaufn /= 1 ) ) & 
    244240         & CALL ctl_stop( ' niaufn /= 0 or niaufn /=1 :',  & 

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90

    r4924 r4932  
    328328               X1= ana_amp(ji,jj,jh,1) 
    329329               X2=-ana_amp(ji,jj,jh,2) 
    330                out_u(ji,jj,jh) = X1 * umask_i(ji,jj) 
    331                out_u (ji,jj,nb_ana+jh) = X2 * umask_i(ji,jj) 
     330               out_u(ji,jj,       jh) = X1 * umask_i(ji,jj) 
     331               out_u(ji,jj,nb_ana+jh) = X2 * umask_i(ji,jj) 
    332332            ENDDO 
    333333         ENDDO 
    … …  
    362362               X1=ana_amp(ji,jj,jh,1) 
    363363               X2=-ana_amp(ji,jj,jh,2) 
    364                out_v(ji,jj,jh)=X1 * vmask_i(ji,jj) 
     364               out_v(ji,jj,       jh)=X1 * vmask_i(ji,jj) 
    365365               out_v(ji,jj,nb_ana+jh)=X2 * vmask_i(ji,jj) 
    366366            END DO 

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r4924 r4932  
    483483      CALL obs_grid_setup( ) 
    484484      IF ( ( n1dint < 0 ).OR.( n1dint > 1 ) ) THEN 
    485          IF(lwp) WRITE(numout,cform_err) 
    486          IF(lwp) WRITE(numout,*) ' Choice of vertical (1D) interpolation method', & 
    487             &                    ' is not available' 
    488          nstop = nstop + 1 
     485         CALL ctl_stop(' Choice of vertical (1D) interpolation method', & 
     486            &                    ' is not available') 
    489487      ENDIF 
    490488      IF ( ( n2dint < 0 ).OR.( n2dint > 4 ) ) THEN 
    491          IF(lwp) WRITE(numout,cform_err) 
    492          IF(lwp) WRITE(numout,*) ' Choice of horizontal (2D) interpolation method', & 
    493             &                    ' is not available' 
    494          nstop = nstop + 1 
     489         CALL ctl_stop(' Choice of horizontal (2D) interpolation method', & 
     490            &                    ' is not available') 
    495491      ENDIF 
    496492 

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/NEMO/OPA_SRC/OBS/jul2greg.h90

    r2287 r4932  
    1616      !!      ! 06-05  (A. Vidard) Reformatted and refdate       
    1717      !!      ! 06-10  (A. Weaver) Cleanup 
     18      !!      ! 2014-09 (D. Lea) Change to use FLOOR to deal with negative prelday 
    1819      !!----------------------------------------------------------------------- 
    1920 
    … …  
    8283 
    8384      zday = prelday 
    84       ksec = NINT( 86400. * MOD( zday, 1. ) ) 
     85      ksec = FLOOR( 86400. * MOD( zday, 1. ) ) 
    8586 
    8687      IF ( ksec < 0. ) ksec = 86400. + ksec 

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90

    r2715 r4932  
    412412         ENDIF 
    413413 
    414          IF (MAXVAL(ixpos(ipx1:ipx,ipy1:ipy)) == -1) CYCLE! cycle if no lookup points found 
     414         IF (.NOT. llfourflag) THEN 
     415            IF (MAXVAL(ixpos(ipx1:ipx,ipy1:ipy)) == -1) CYCLE! cycle if no lookup points found 
     416         ENDIF 
    415417          
    416418         jimin = 0 
    … …  
    996998                        df = ABS( iypos(ji+1,jj) - iypos(ji,jj) ) 
    997999                        tmpy1 = df 
    998                         IF ( df < limxdiff ) numy1 = numy1 + 1 
     1000                        IF ( df < limydiff ) numy1 = numy1 + 1 
    9991001                        IF ( df < histsize ) histy1(df+1) = histy1(df+1) + 1 
    10001002                     ENDIF 
    … …  
    10021004                        df = ABS( iypos(ji,jj+1) - iypos(ji,jj) ) 
    10031005                        tmpy2 = df 
    1004                         IF ( df < limxdiff ) numy2 = numy2+1 
     1006                        IF ( df < limydiff ) numy2 = numy2+1 
    10051007                        IF ( df < histsize ) histy2(df+1) = histy2(df+1)+1 
    10061008                     ENDIF 

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90

    r4292 r4932  
    143143      INTEGER :: is3dt 
    144144      INTEGER :: ip3dt 
     145      INTEGER :: ios 
     146      INTEGER :: ioserrcount 
    145147      INTEGER, DIMENSION(kvars) :: & 
    146148         & iv3dt 
    … …  
    280282               &           krefdate = irefdate(jj) ) 
    281283 
     284            ioserrcount=0 
    282285            IF ( ldavtimset ) THEN 
    283286               DO ji = 1, inpfiles(jj)%nobs 
    … …  
    287290                  !  to be the  end of the day 
    288291                  ! 
    289                   READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype 
     292                  READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 900 ) itype 
     293900               IF ( ios /= 0 ) THEN 
     294                     itype = 0         ! Set type to zero if there is a problem in the string conversion 
     295                  ENDIF 
    290296                  IF ( ANY (idailyavtypes == itype ) ) THEN 
    291297                     inpfiles(jj)%ptim(ji) = & 
    … …  
    468474      itypsmpp(:) = 0 
    469475       
    470        
     476      ioserrcount = 0       
    471477      DO jk = 1, iproftot 
    472478          
    … …  
    552558                
    553559               ! Instrument type 
    554                READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype 
     560               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype 
     561901            IF ( ios /= 0 ) THEN 
     562                  IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' ) 
     563                  ioserrcount = ioserrcount + 1 
     564                  itype = 0 
     565               ENDIF 
     566                
    555567               profdata%ntyp(iprof) = itype 
    556568                

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90

    r3651 r4932  
    120120      INTEGER :: iobs 
    121121      INTEGER :: iobstot 
     122      INTEGER :: ios 
     123      INTEGER :: ioserrcount 
    122124      CHARACTER(len=8) :: cl_refdate 
    123125    
    … …  
    335337      ityp   (:) = 0 
    336338      itypmpp(:) = 0 
    337        
     339 
     340      ioserrcount=0       
     341 
    338342      DO jk = 1, iobstot 
    339343          
    … …  
    382386                
    383387               ! Instrument type 
    384                READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype 
     388               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype 
     389901            IF ( ios /= 0 ) THEN 
     390                  IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' )  
     391                  ioserrcount = ioserrcount + 1 
     392                  itype = 0 
     393               ENDIF 
    385394               seaicedata%ntyp(iobs) = itype 
    386395               IF ( itype < iseaicemaxtype + 1 ) THEN 

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sla.F90

    r3651 r4932  
    125125      INTEGER :: iobs 
    126126      INTEGER :: iobstot 
     127      INTEGER :: ios 
     128      INTEGER :: ioserrcount 
    127129      CHARACTER(len=8) :: cl_refdate 
    128130    
    … …  
    391393         &               iindx   ) 
    392394       
    393       CALL obs_surf_alloc( sladata, iobs, kvars, kextr, & 
    394          &                 jpi, jpj, kstp ) 
     395      CALL obs_surf_alloc( sladata, iobs, kvars, kextr, kstp, jpi, jpj ) 
    395396       
    396397      ! * Read obs/positions, QC, all variable and assign to sladata 
    … …  
    400401      ityp   (:) = 0 
    401402      itypmpp(:) = 0 
     403 
     404      ioserrcount = 0 
    402405       
    403406      DO jk = 1, iobstot 
    … …  
    451454                
    452455               ! Instrument type 
    453                READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype 
     456               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype 
     457901            IF ( ios /= 0 ) THEN 
     458                  IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' )  
     459                  ioserrcount = ioserrcount + 1 
     460                  itype = 0 
     461               ENDIF 
    454462               sladata%ntyp(iobs) = itype 
    455463               ityp(itype+1) = ityp(itype+1) + 1 

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sst.F90

    r3651 r4932  
    120120      INTEGER :: iobs 
    121121      INTEGER :: iobstot 
     122      INTEGER :: ios 
     123      INTEGER :: ioserrcount 
    122124      CHARACTER(len=8) :: cl_refdate 
    123125    
    … …  
    335337      itypmpp(:) = 0 
    336338       
     339      ioserrcount = 0 
     340       
    337341      DO jk = 1, iobstot 
    338342          
    … …  
    381385                
    382386               ! Instrument type 
    383                READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype 
     387               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype 
     388901            IF ( ios /= 0 ) THEN 
     389                  IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' )  
     390                  ioserrcount = ioserrcount + 1 
     391                  itype = 0 
     392               ENDIF 
    384393               sstdata%ntyp(iobs) = itype 
    385394               IF ( itype < isstmaxtype + 1 ) THEN 

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90

    r4292 r4932  
    130130      INTEGER :: iproftot 
    131131      INTEGER :: iuv3dt 
     132      INTEGER :: ios 
     133      INTEGER :: ioserrcount 
    132134      INTEGER, DIMENSION(kvars) :: iv3dt 
    133135      CHARACTER(len=8) :: cl_refdate 
    … …  
    459461                
    460462               ! Instrument type 
    461                READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype 
     463               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype 
     464901            IF ( ios /= 0 ) THEN 
     465                  IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' )  
     466                  ioserrcount = ioserrcount + 1 
     467                  itype = 0 
     468               ENDIF 
    462469               profdata%ntyp(iprof) = itype 
    463470                

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90

    r2287 r4932  
    66 
    77   !!---------------------------------------------------------------------- 
    8    !!   cdf_wri_p3d   : Write profile observation diagnostics in NetCDF format 
     8   !!   obs_wri_p3d   : Write profile observation diagnostics in NetCDF format 
    99   !!   obs_wri_sla   : Write SLA observation related diagnostics 
    1010   !!   obs_wri_sst   : Write SST observation related diagnostics 
    1111   !!   obs_wri_seaice: Write seaice observation related diagnostics 
    12    !!   cdf_wri_vel   : Write velocity observation diagnostics in NetCDF format 
     12   !!   obs_wri_vel   : Write velocity observation diagnostics in NetCDF format 
     13   !!   obs_wri_stats : Print basic statistics on the data being written out 
    1314   !!---------------------------------------------------------------------- 
    1415 
    … …  
    3132   USE obs_sla_types 
    3233   USE obs_rot_vel          ! Rotation of velocities 
     34   USE obs_mpp              ! MPP support routines for observation diagnostics 
     35   USE lib_mpp        ! MPP routines 
    3336 
    3437   IMPLICIT NONE 
    … …  
    256259      ! Write the obfbdata structure 
    257260      CALL write_obfbdata( cfname, fbdata ) 
    258        
     261 
     262      ! Output some basic statistics 
     263      CALL obs_wri_stats( fbdata ) 
     264 
    259265      CALL dealloc_obfbdata( fbdata ) 
    260266      
    … …  
    414420      CALL write_obfbdata( cfname, fbdata ) 
    415421 
     422      ! Output some basic statistics 
     423      CALL obs_wri_stats( fbdata ) 
     424 
    416425      CALL dealloc_obfbdata( fbdata ) 
    417426 
    … …  
    565574      CALL write_obfbdata( cfname, fbdata ) 
    566575 
     576      ! Output some basic statistics 
     577      CALL obs_wri_stats( fbdata ) 
     578 
    567579      CALL dealloc_obfbdata( fbdata ) 
    568580 
    … …  
    715727      CALL write_obfbdata( cfname, fbdata ) 
    716728 
     729      ! Output some basic statistics 
     730      CALL obs_wri_stats( fbdata ) 
     731 
    717732      CALL dealloc_obfbdata( fbdata ) 
    718733 
    … …  
    722737      !!----------------------------------------------------------------------- 
    723738      !! 
    724       !!                     *** ROUTINE obs_wri_p3d  *** 
     739      !!                     *** ROUTINE obs_wri_vel  *** 
    725740      !! 
    726741      !! ** Purpose : Write current (profile) observation  
    … …  
    903918      CALL write_obfbdata( cfname, fbdata ) 
    904919       
     920      ! Output some basic statistics 
     921      CALL obs_wri_stats( fbdata ) 
     922 
    905923      CALL dealloc_obfbdata( fbdata ) 
    906924      
    … …  
    912930   END SUBROUTINE obs_wri_vel 
    913931 
     932   SUBROUTINE obs_wri_stats( fbdata ) 
     933      !!----------------------------------------------------------------------- 
     934      !! 
     935      !!                     *** ROUTINE obs_wri_stats  *** 
     936      !! 
     937      !! ** Purpose : Output some basic statistics of the data being written out 
     938      !! 
     939      !! ** Method  : 
     940      !!  
     941      !! ** Action  : 
     942      !! 
     943      !!      ! 2014-08  (D. Lea) Initial version  
     944      !!----------------------------------------------------------------------- 
     945 
     946      !! * Arguments 
     947      TYPE(obfbdata) :: fbdata 
     948 
     949      !! * Local declarations 
     950      INTEGER :: jvar 
     951      INTEGER :: jo 
     952      INTEGER :: jk 
     953 
     954!      INTEGER :: nlev 
     955!      INTEGER :: nlevmpp 
     956!      INTEGER :: nobsmpp 
     957      INTEGER :: numgoodobs 
     958      INTEGER :: numgoodobsmpp 
     959      REAL(wp) :: zsumx 
     960      REAL(wp) :: zsumx2 
     961      REAL(wp) :: zomb 
     962 
     963      IF (lwp) THEN 
     964         WRITE(numout,*) '' 
     965         WRITE(numout,*) 'obs_wri_stats :' 
     966         WRITE(numout,*) '~~~~~~~~~~~~~~~'  
     967      ENDIF 
     968 
     969      DO jvar = 1, fbdata%nvar 
     970         zsumx=0.0_wp 
     971         zsumx2=0.0_wp 
     972         numgoodobs=0 
     973         DO jo = 1, fbdata%nobs 
     974            DO jk = 1, fbdata%nlev 
     975               IF ( ( fbdata%pob(jk,jo,jvar) < 9999.0 ) .AND. & 
     976                  & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. & 
     977                  & ( fbdata%padd(jk,jo,1,jvar) < 9999.0 ) ) THEN 
     978        
     979             zomb=fbdata%pob(jk, jo, jvar)-fbdata%padd(jk, jo, 1, jvar) 
     980                  zsumx=zsumx+zomb 
     981                  zsumx2=zsumx2+zomb**2 
     982                  numgoodobs=numgoodobs+1 
     983          ENDIF 
     984            ENDDO 
     985         ENDDO 
     986 
     987         CALL obs_mpp_sum_integer( numgoodobs, numgoodobsmpp ) 
     988         CALL mpp_sum(zsumx) 
     989         CALL mpp_sum(zsumx2) 
     990 
     991         IF (lwp) THEN 
     992       WRITE(numout,*) 'Type: ',fbdata%cname(jvar),'  Total number of good observations: ',numgoodobsmpp  
     993       WRITE(numout,*) 'Overall mean obs minus model of the good observations: ',zsumx/numgoodobsmpp 
     994            WRITE(numout,*) 'Overall RMS obs minus model of the good observations: ',sqrt( zsumx2/numgoodobsmpp ) 
     995       WRITE(numout,*) '' 
     996         ENDIF 
     997  
     998      ENDDO 
     999 
     1000   END SUBROUTINE obs_wri_stats 
     1001 
    9141002END MODULE obs_write 
Note: See TracChangeset for help on using the changeset viewer.