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 – NEMO

Ignore:
Timestamp:
2014-12-01T11:08:54+01:00 (9 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
Files:
23 edited
8 copied

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg

    r4329 r4932  
    183183!----------------------------------------------------------------------- 
    184184/ 
     185!----------------------------------------------------------------------- 
     186&namobs       !  observation usage                                      ('key_diaobs') 
     187!----------------------------------------------------------------------- 
     188/ 
     189!----------------------------------------------------------------------- 
     190&nam_asminc   !   assimilation increments                               ('key_asminc') 
     191!----------------------------------------------------------------------- 
     192/ 

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_cfg

    r4370 r4932  
    188188!----------------------------------------------------------------------- 
    189189/ 
     190!----------------------------------------------------------------------- 
     191&namobs       !  observation usage                                      ('key_diaobs') 
     192!----------------------------------------------------------------------- 
     193/ 
     194!----------------------------------------------------------------------- 
     195&nam_asminc   !   assimilation increments                               ('key_asminc') 
     196!----------------------------------------------------------------------- 
     197/ 

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm

    r4523 r4932  
    1  bld::tool::fppkeys key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi 
     1bld::tool::fppkeys key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_diaobs key_asminc 

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/CONFIG/ORCA2_LIM3/cpp_ORCA2_LIM3.fcm

    r4161 r4932  
    1  bld::tool::fppkeys key_trabbl key_lim3 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi 
     1 bld::tool::fppkeys key_trabbl key_lim3 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_diaobs key_asminc 

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/CONFIG/SHARED/1_namelist_ref

    r4924 r4932  
    11031103                           !     ln_ssh                  Logical switch for SSH observations 
    11041104 
    1105    ln_sst     = .true.     ! Logical switch for SST observations 
    1106    ln_reysst  = .true.     !     ln_reysst               Logical switch for Reynolds observations 
     1105   ln_sst     = .false.     ! Logical switch for SST observations 
     1106   ln_reysst  = .false.     !     ln_reysst               Logical switch for Reynolds observations 
    11071107   ln_ghrsst  = .false.    !     ln_ghrsst               Logical switch for GHRSST observations       
    11081108 
    11091109   ln_sstfb   = .false.    ! Logical switch for feedback SST data 
    11101110                           !     ln_sss                  Logical switch for SSS observations 
    1111                            !     ln_seaice              Logical switch for Sea Ice observations 
     1111   ln_seaice  = .false.    ! Logical switch for Sea Ice observations 
    11121112                           !     ln_vel3d                Logical switch for velocity observations 
    11131113                           !     ln_velavcur             Logical switch for velocity daily av. cur. 
    … …  
    11301130                           !     sstfiles                GHRSST input observation file name 
    11311131   !                       ! sstfbfiles: Feedback SST input observation file name 
    1132    sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc' 
     1132   sstfbfiles = 'sst_01.nc' 
    11331133                           !     seaicefiles             Sea Ice input observation file name 
     1134   seaicefiles = 'seaice_01.nc' 
    11341135                           !     velavcurfiles           Vel. cur. daily av. input file name 
    11351136                           !     velhvcurfiles           Vel. cur. high freq. input file name 

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/CONFIG/SHARED/namelist_ref

    r4924 r4932  
    11481148                           !     ln_ssh                  Logical switch for SSH observations 
    11491149 
    1150    ln_sst     = .true.     ! Logical switch for SST observations 
    1151    ln_reysst  = .true.     !     ln_reysst               Logical switch for Reynolds observations 
     1150   ln_sst     = .false.     ! Logical switch for SST observations 
     1151   ln_reysst  = .false.     !     ln_reysst               Logical switch for Reynolds observations 
    11521152   ln_ghrsst  = .false.    !     ln_ghrsst               Logical switch for GHRSST observations       
    11531153 
    11541154   ln_sstfb   = .false.    ! Logical switch for feedback SST data 
    11551155                           !     ln_sss                  Logical switch for SSS observations 
    1156                            !     ln_seaice              Logical switch for Sea Ice observations 
     1156   ln_seaice  = .false.    ! Logical switch for Sea Ice observations 
    11571157                           !     ln_vel3d                Logical switch for velocity observations 
    11581158                           !     ln_velavcur             Logical switch for velocity daily av. cur. 
    … …  
    11751175                           !     sstfiles                GHRSST input observation file name 
    11761176   !                       ! sstfbfiles: Feedback SST input observation file name 
    1177    sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc' 
    1178                            !     seaicefiles             Sea Ice input observation file name 
     1177   sstfbfiles = 'sst_01.nc' 
     1178                           !     seaicefiles             Sea Ice input observation file names 
     1179   seaicefiles = 'seaice_01.nc'   
    11791180                           !     velavcurfiles           Vel. cur. daily av. input file name 
    11801181                           !     velhvcurfiles           Vel. cur. high freq. input file name 

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

    r4924 r4932  
    7777      z1_area = 1.d0 / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 ) 
    7878 
    79       zinda = MAX( 0.d0 , SIGN( 1.d0 , glob_sum( area(:,:) * tms(:,:) ) - epsi06 ) ) 
     79      zinda = MAX( 0._wp , SIGN( 1._wp , glob_sum( area(:,:) * tms(:,:) ) - epsi06 ) ) 
    8080      ! ----------------------- ! 
    8181      ! 1 -  Content variations ! 
    … …  
    153153      ! 3 - Diagnostics writing ! 
    154154      ! ----------------------- ! 
    155       zindb = MAX( 0.d0 , SIGN( 1.d0 , zbg_ivo - epsi06 ) ) 
     155      zindb = MAX( 0._wp , SIGN( 1._wp , zbg_ivo - epsi06 ) ) 
    156156      ! 
    157157      CALL iom_put( 'ibgvoltot' , zbg_ivo * rhoic * r1_rau0 * 1.e-9        )   ! ice volume (km3 equivalent liquid)          

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r4924 r4932  
    301301 
    302302      IF(lwp) THEN  
    303          WRITE(numout,*), ' ztests : ', ztests 
     303         WRITE(numout,*) ' ztests : ', ztests 
    304304         IF ( ztests .NE. 4 ) THEN 
    305305            WRITE(numout,*) 
    306             WRITE(numout,*), ' !!!! ALERT                  !!! ' 
    307             WRITE(numout,*), ' !!!! Something is wrong in the LIM3 initialization procedure ' 
     306            WRITE(numout,*) ' !!!! ALERT                  !!! ' 
     307            WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure ' 
    308308            WRITE(numout,*) 
    309             WRITE(numout,*), ' *** ztests is not equal to 4 ' 
    310             WRITE(numout,*), ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 
    311             WRITE(numout,*), ' zat_i_ini : ', zat_i_ini(i_hemis) 
    312             WRITE(numout,*), ' zht_i_ini : ', zht_i_ini(i_hemis) 
     309            WRITE(numout,*) ' *** ztests is not equal to 4 ' 
     310            WRITE(numout,*) ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 
     311            WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(i_hemis) 
     312            WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(i_hemis) 
    313313         ENDIF ! ztests .NE. 4 
    314314      ENDIF 

  • 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 

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/SETTE/sette.sh

    r4924 r4932  
    140140# SAS             :11 & 12 
    141141# ISOMIP          :13 & 14 
    142 # ORCA2_AGRIF_LIM :15 
    143 for config in 9 10 #1 2 3 4 5 6 7 8 9 10 13 14 # 1 2 5 6 7 8 9 10 11 12 13 14 
     142# ORCA2_LIM_OBS:   15 
     143# ORCA2_AGRIF_LIM :16 
     144for config in  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 
    144145 
    145146do 
    … …  
    11261127fi 
    11271128 
     1129## Test assimilation interface code, OBS and ASM for reproducibility 
     1130## Restartability not tested (ASM code not restartable while increments are being applied) 
     1131if [ ${config} -eq 15 ] ; then 
     1132   ## Reproducibility tests for ORCA2_LIM_OBS 
     1133    export TEST_NAME="REPRO_4_4" 
     1134    cd ${CONFIG_DIR} 
     1135    . ./makenemo -m ${CMP_NAM} -n ORCA2_LIM_OBS -r ORCA2_LIM -j 8 add_key "key_mpp_rep key_diaobs key_asminc" del_key ${DEL_KEYS} 
     1136    cd ${SETTE_DIR} 
     1137    . ./param.cfg 
     1138    . ./all_functions.sh 
     1139    . ./prepare_exe_dir.sh 
     1140    JOB_FILE=${EXE_DIR}/run_job.sh 
     1141    NPROC=16 
     1142    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
     1143    cd ${EXE_DIR} 
     1144    set_namelist namelist_cfg nn_it000 1 
     1145    set_namelist namelist_cfg nn_itend 75 
     1146    set_namelist namelist_cfg nn_fwb 0 
     1147    set_namelist namelist_cfg ln_ctl .false. 
     1148    set_namelist namelist_cfg ln_clobber .true. 
     1149    set_namelist namelist_cfg jpni 4 
     1150    set_namelist namelist_cfg jpnj 4 
     1151    set_namelist namelist_cfg jpnij 16 
     1152    set_namelist namelist_cfg nn_solv 2    
     1153    set_namelist namelist_cfg ln_t3d .true. 
     1154    set_namelist namelist_cfg ln_s3d .true. 
     1155    set_namelist namelist_cfg ln_profb .true. 
     1156    set_namelist namelist_cfg ln_sst .true. 
     1157    set_namelist namelist_cfg ln_sstfb .true. 
     1158    set_namelist namelist_cfg ln_sla .true. 
     1159    set_namelist namelist_cfg ln_slafb .true. 
     1160    set_namelist namelist_cfg ln_seaice .false. 
     1161    set_namelist namelist_cfg ln_bkgwri .true. 
     1162    set_namelist namelist_cfg ln_trainc .true. 
     1163    set_namelist namelist_cfg ln_dyninc .true. 
     1164    set_namelist namelist_cfg ln_sshinc .true. 
     1165    set_namelist namelist_cfg ln_asmiau .true. 
     1166    if [ ${USING_MPMD} == "yes" ] ; then 
     1167       set_xio_using_server iodef.xml true 
     1168    else 
     1169       set_xio_using_server iodef.xml false 
     1170    fi 
     1171    cd ${SETTE_DIR} 
     1172    . ./prepare_job.sh input_ORCA2_LIM_OBS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 
     1173    cd ${SETTE_DIR} 
     1174    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 
     1175 
     1176   cd ${SETTE_DIR} 
     1177    export TEST_NAME="REPRO_2_8" 
     1178    . ./prepare_exe_dir.sh 
     1179    JOB_FILE=${EXE_DIR}/run_job.sh 
     1180    NPROC=16 
     1181    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
     1182    cd ${EXE_DIR} 
     1183    set_namelist namelist_cfg nn_it000 1 
     1184    set_namelist namelist_cfg nn_itend 75 
     1185    set_namelist namelist_cfg nn_fwb 0 
     1186    set_namelist namelist_cfg ln_ctl .false. 
     1187    set_namelist namelist_cfg ln_clobber .true. 
     1188    set_namelist namelist_cfg jpni 2 
     1189    set_namelist namelist_cfg jpnj 8 
     1190    set_namelist namelist_cfg jpnij 16 
     1191    set_namelist namelist_cfg nn_solv 2 
     1192    set_namelist namelist_cfg ln_t3d .true. 
     1193    set_namelist namelist_cfg ln_s3d .true. 
     1194    set_namelist namelist_cfg ln_profb .true. 
     1195    set_namelist namelist_cfg ln_sst .true. 
     1196    set_namelist namelist_cfg ln_sstfb .true. 
     1197    set_namelist namelist_cfg ln_sla .true. 
     1198    set_namelist namelist_cfg ln_slafb .true. 
     1199    set_namelist namelist_cfg ln_seaice .false. 
     1200    set_namelist namelist_cfg ln_bkgwri .true. 
     1201    set_namelist namelist_cfg ln_trainc .true. 
     1202    set_namelist namelist_cfg ln_dyninc .true. 
     1203    set_namelist namelist_cfg ln_sshinc .true. 
     1204    set_namelist namelist_cfg ln_asmiau .true. 
     1205    if [ ${USING_MPMD} == "yes" ] ; then 
     1206       set_xio_using_server iodef.xml true 
     1207    else 
     1208       set_xio_using_server iodef.xml false 
     1209    fi 
     1210    cd ${SETTE_DIR} 
     1211    . ./prepare_job.sh input_ORCA2_LIM_OBS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 
     1212    cd ${SETTE_DIR} 
     1213    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 
     1214fi 
    11281215# TEST FOR ORCA2_LIM_AGRIF : simple test of running AGRIF (no restartability neither reproducibility tests) 
    1129 if [ ${config} -eq 15 ] ;  then 
     1216if [ ${config} -eq 16 ] ;  then 
    11301217    ## ORCA2_LIM with Agulhas AGRIF zoom in MPI 
    11311218    export TEST_NAME="SHORT" 

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/SETTE/sette_rpt

    r4924 r4932  
    171171    rm f1.tmp$$ 
    172172  endif 
     173<<<<<<< .working 
    173174  if ( -d ./WORCA2LIM3_LONG ) then 
    174175    set dorv = `ls -1rtd ./WORCA2LIM3_LONG/{$mach}/* | tail -1l ` 
    … …  
    178179    set f2o = ./WORCA2LIM3_LONG/{$mach}/{$dorv}/SHORT/ocean.output 
    179180    set f2s = ./WORCA2LIM3_LONG/{$mach}/{$dorv}/SHORT/solver.stat 
    180  
     181======= 
     182NEXT0: 
     183  if ( -d ./WSAS_LONG ) then 
     184    set dorv = `ls -1rtd ./WSAS_LONG/{$mach}/* | tail -1l ` 
     185    set dorv = $dorv:t 
     186    set f1o = ./WSAS_LONG/{$mach}/{$dorv}/LONG/ocean.output 
     187    set f1s = ./WSAS_LONG/{$mach}/{$dorv}/LONG/solver.stat 
     188    set f2o = ./WSAS_LONG/{$mach}/{$dorv}/SHORT/ocean.output 
     189    set f2s = ./WSAS_LONG/{$mach}/{$dorv}/SHORT/solver.stat 
     190>>>>>>> .merge-right.r4926 
     191 
     192<<<<<<< .working 
    181193    set nl = `wc -l $f2s` 
    182194    tail -$nl[1] $f1s > f1.tmp$$ 
    … …  
    237249 
    238250NEXT: 
     251======= 
     252    foreach f ( $f1o $f1s $f2o $f2s ) 
     253     if ( ! -f $f ) then 
     254      echo 'SAS         restartability  inconclusive ( ' $f:t ' not found )' 
     255      goto NEXT 
     256     endif 
     257    end 
     258 
     259    set nl = `wc -l $f2s` 
     260    tail -$nl[1] $f1s > f1.tmp$$ 
     261    cmp -s f1.tmp$$ $f2s 
     262    if ( $status == 0 ) then 
     263      echo "SAS         restartability  passed" 
     264    else 
     265      echo "SAS         restartability  FAILED" 
     266      if ( $pass == 1 ) then 
     267        echo "<return> to view solver.stat differences" 
     268        set y = $< 
     269        sdiff f1.tmp$$ $f2s 
     270        echo "<return> to view ocean.output differences" 
     271        set y = $< 
     272        sdiff $f1o $f2o | grep "|" 
     273        echo "<return> to continue" 
     274        set y = $< 
     275      endif 
     276    endif 
     277    rm f1.tmp$$ 
     278  endif 
     279 
     280NEXT: 
     281>>>>>>> .merge-right.r4926 
    239282echo 
    240283   
    … …  
    376419    set f2s = ./WORCA2LIM3_16/{$mach}/{$dorv}/REPRO_4_4/solver.stat 
    377420 
     421<<<<<<< .working 
    378422    cmp -s $f1s $f2s 
    379423    if ( $status == 0 ) then 
    … …  
    429473NEXT1: 
    430474 
     475======= 
     476  if ( -d ./WSAS_32 ) then 
     477    set dorv = `ls -1rtd ./WSAS_32/{$mach}/* | tail -1l ` 
     478    set dorv = $dorv:t 
     479    set f1o = ./WSAS_32/{$mach}/{$dorv}/REPRO_4_8/ocean.output 
     480    set f1s = ./WSAS_32/{$mach}/{$dorv}/REPRO_4_8/solver.stat 
     481    set f2o = ./WSAS_32/{$mach}/{$dorv}/REPRO_8_4/ocean.output 
     482    set f2s = ./WSAS_32/{$mach}/{$dorv}/REPRO_8_4/solver.stat 
     483 
     484    foreach f ( $f1o $f1s $f2o $f2s ) 
     485     if ( ! -f $f ) then 
     486      echo 'SAS         reproducibility inconclusive ( ' $f:t ' not found )' 
     487      goto NEXT1 
     488     endif 
     489    end 
     490 
     491    cmp -s $f1s $f2s 
     492    if ( $status == 0 ) then 
     493      echo "SAS reproducibility passed" 
     494    else 
     495      echo "SAS reproducibility FAILED" 
     496      if ( $pass == 1 ) then 
     497        echo "<return> to view solver.stat differences" 
     498        set y = $< 
     499        sdiff $f1s $f2s 
     500        echo "<return> to view ocean.output differences" 
     501        set y = $< 
     502        sdiff $f1o $f2o | grep "|" 
     503        echo "<return> to continue" 
     504        set y = $< 
     505      endif 
     506    endif 
     507  endif 
     508NEXT1: 
     509 
     510>>>>>>> .merge-right.r4926 
    431511  if ( -d ./WORCA2AGUL_1_2 ) then 
    432512    set dorv = `ls -1rtd ./WORCA2AGUL_1_2/{$mach}/* | tail -1l ` 

  • branches/2014/dev_r4879_UKMO_NOC_MERGE/NEMOGCM/TOOLS/OBSTOOLS/src/date_utils.F90

    r3000 r4932  
    3434 
    3535   END SUBROUTINE add_date 
     36 
     37 
     38   SUBROUTINE add_days_to_date(initial_date,days,final_date) 
     39 
     40      ! Add a number of days to initial_date and return it in final_date 
     41 
     42      IMPLICIT NONE 
     43 
     44 
     45      !! Arguments 
     46      INTEGER,INTENT(in) :: initial_date ! Initial date (YYYYMMDD) 
     47      INTEGER,INTENT(in) :: days         ! Number of days to add 
     48      INTEGER,INTENT(out) :: final_date  ! Final date (YYYYMMDD) 
     49 
     50      !! Local variables 
     51 
     52      INTEGER :: isec,imin,ihours,iyear,imon,iday ! temporary results 
     53      REAL(dp):: juld 
     54 
     55      ! Account for lack of hours in date format (initial_date*100) 
     56      CALL split_date(initial_date*100,iyear,imon,iday,ihours) 
     57 
     58      CALL greg2jul(0,0,ihours,iday,imon,iyear,juld) 
     59 
     60      juld=juld+REAL(days) 
     61 
     62      CALL jul2greg(isec,imin,ihours,iday,imon,iyear,juld) 
     63 
     64      final_date=(iyear*1000000+imon*10000+iday*100+ihours)/100 
     65 
     66   END SUBROUTINE add_days_to_date 
     67 
    3668 
    3769   SUBROUTINE split_date(iyyyymmddhh,iyyyy,imm,idd,ihh) 
    … …  
    379411   END FUNCTION diffdate 
    380412 
     413   INTEGER FUNCTION difftime(itime1,itime2) 
     414 
     415      ! Compute difference in minutes between times 
     416      ! Assumes HHMM or HMM or MM or M format for dates 
     417      ! 
     418      ! ORDER MATTERS - itime1 is ealier time 
     419      ! Result is an integer number of minutes 
     420 
     421      IMPLICIT NONE 
     422      INTEGER, INTENT(IN) :: itime1,itime2    ! Times to be diffed. 
     423      INTEGER :: imin1, imin2, ihr1, ihr2 
     424 
     425      ihr1 = (itime1/100) 
     426      ihr2 = (itime2/100) 
     427       
     428      imin1 = (itime1 - ihr1*100) + (60 * ihr1) 
     429      imin2 = (itime2 - ihr2*100) + (60 * ihr2) 
     430       
     431      ! Assume that itime2 is later, so wrap around midnight if necessary. 
     432      IF (imin2 < imin1) THEN 
     433         imin2 = imin2 + 24*60 
     434      END IF 
     435       
     436      difftime = imin2 - imin1 
     437       
     438   END FUNCTION difftime 
     439 
     440 
     441   INTEGER FUNCTION add_mins_to_time(itime1, imin_add) 
     442 
     443      ! Add number of minutes onto given time 
     444      ! Assumes time in HHMM or HMM or MM or M format 
     445      ! 
     446      ! Result is in HHMM format 
     447 
     448      IMPLICIT NONE 
     449      INTEGER, INTENT(IN) :: itime1,imin_add 
     450      INTEGER :: imin1, ihr1, imin2, ihr2 
     451 
     452      ihr1 = (itime1/100) 
     453       
     454      ! itime1 in minutes from previous midnight 
     455      imin1 = (itime1 - ihr1*100) + (60 * ihr1) 
     456       
     457      imin1 = imin1 + imin_add 
     458       
     459      ! Add 1day if time went nagative 
     460      IF (imin1 < 0) THEN 
     461         imin1 = imin1 + 24*60 
     462      END IF 
     463       
     464      ! Turn number of minutes back into HHMM 
     465      ihr2 = imin1/60 
     466      imin2 = imin1 - ihr2*60 
     467 
     468      DO 
     469         IF (ihr2<0) THEN 
     470            ihr2 = ihr2 + 24 
     471         ELSE IF (ihr2>=24) THEN 
     472            ihr2 = ihr2 - 24 
     473         END IF 
     474         IF ((ihr2>=0).OR.(ihr2<24)) EXIT 
     475      END DO 
     476 
     477      add_mins_to_time = ihr2*100 + imin2 
     478    
     479   END FUNCTION add_mins_to_time 
     480 
    381481 
    382482END MODULE date_utils 
Note: See TracChangeset for help on using the changeset viewer.