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 2074 for branches – NEMO

Changeset 2074 for branches


Ignore:
Timestamp:
2010-09-08T16:59:58+02:00 (14 years ago)
Author:
djlea
Message:

Fix for obs_readmdt which was producing errors in certain processor configurations. Also a tidy of the code.

Location:
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS
Files:
40 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/ddatetoymdhms.h90

    r2001 r2074  
    1515 
    1616      !! * Arguments 
    17       REAL(dp), INTENT(IN) :: & 
    18          & ddate 
    19       INTEGER, INTENT(OUT) :: &  
    20          & kyea, & 
    21          & kmon, & 
    22          & kday, & 
    23          & khou, & 
    24          & kmin, & 
    25          & ksec 
     17      REAL(dp), INTENT(IN) :: ddate 
     18      INTEGER, INTENT(OUT) :: kyea 
     19      INTEGER, INTENT(OUT) :: kmon 
     20      INTEGER, INTENT(OUT) :: kday 
     21      INTEGER, INTENT(OUT) :: khou 
     22      INTEGER, INTENT(OUT) :: kmin 
     23      INTEGER, INTENT(OUT) :: ksec 
    2624      !! * Local declarations 
    27       INTEGER :: & 
    28          & iyymmdd, & 
    29          & ihhmmss 
     25      INTEGER :: iyymmdd 
     26      INTEGER :: ihhmmss 
    3027       
    3128      iyymmdd = INT( ddate ) 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/diaobs.F90

    r2001 r2074  
    5757 
    5858   !! * Module variables 
    59    LOGICAL, PUBLIC :: & 
    60       & ln_t3d,    & !: Logical switch for temperature profiles 
    61       & ln_s3d,    & !: Logical switch for salinity profiles 
    62       & ln_ena,    & !: Logical switch for the ENACT data set 
    63       & ln_cor,    & !: Logical switch for the Coriolis data set 
    64       & ln_profb,  & !: Logical switch for profile feedback datafiles 
    65       & ln_sla,    & !: Logical switch for sea level anomalies  
    66       & ln_sladt,  & !: Logical switch for SLA from AVISO files 
    67       & ln_slafb,  & !: Logical switch for SLA from feedback files 
    68       & ln_sst,    & !: Logical switch for sea surface temperature 
    69       & ln_reysst, & !: Logical switch for Reynolds sea surface temperature 
    70       & ln_ghrsst, & !: Logical switch for GHRSST data 
    71       & ln_sstfb,  & !: Logical switch for SST from feedback files 
    72       & ln_seaice, & !: Logical switch for sea ice concentration 
    73       & ln_vel3d,  & !: Logical switch for velocity component (u,v) observations 
    74       & ln_velavcur, & !: Logical switch for raw daily averaged netCDF current meter vel. data  
    75       & ln_velhrcur, & !: Logical switch for raw high freq netCDF current meter vel. data  
    76       & ln_velavadcp, & !: Logical switch for raw daily averaged netCDF ADCP vel. data  
    77       & ln_velhradcp, & !: Logical switch for raw high freq netCDF ADCP vel. data  
    78       & ln_velfb,  & !: Logical switch for velocities from feedback files 
    79       & ln_ssh,    & !: Logical switch for sea surface height 
    80       & ln_sss,    & !: Logical switch for sea surface salinity 
    81       & ln_nea,    & !: Remove observations near land 
    82       & ln_altbias,& !: Logical switch for altimeter bias   
    83       & ln_ignmis, & !: Logical switch for ignoring missing files 
    84       & ln_s_at_t    !: Logical switch to compute model S at T observations 
    85  
    86    REAL(KIND=dp), PUBLIC :: & 
    87       & dobsini, &   !: Observation window start date YYYYMMDD.HHMMSS 
    88       & dobsend      !: Observation window end date YYYYMMDD.HHMMSS 
     59   LOGICAL, PUBLIC :: ln_t3d         !: Logical switch for temperature profiles 
     60   LOGICAL, PUBLIC :: ln_s3d         !: Logical switch for salinity profiles 
     61   LOGICAL, PUBLIC :: ln_ena         !: Logical switch for the ENACT data set 
     62   LOGICAL, PUBLIC :: ln_cor         !: Logical switch for the Coriolis data set 
     63   LOGICAL, PUBLIC :: ln_profb       !: Logical switch for profile feedback datafiles 
     64   LOGICAL, PUBLIC :: ln_sla         !: Logical switch for sea level anomalies  
     65   LOGICAL, PUBLIC :: ln_sladt       !: Logical switch for SLA from AVISO files 
     66   LOGICAL, PUBLIC :: ln_slafb       !: Logical switch for SLA from feedback files 
     67   LOGICAL, PUBLIC :: ln_sst         !: Logical switch for sea surface temperature 
     68   LOGICAL, PUBLIC :: ln_reysst      !: Logical switch for Reynolds sea surface temperature 
     69   LOGICAL, PUBLIC :: ln_ghrsst      !: Logical switch for GHRSST data 
     70   LOGICAL, PUBLIC :: ln_sstfb       !: Logical switch for SST from feedback files 
     71   LOGICAL, PUBLIC :: ln_seaice      !: Logical switch for sea ice concentration 
     72   LOGICAL, PUBLIC :: ln_vel3d       !: Logical switch for velocity component (u,v) observations 
     73   LOGICAL, PUBLIC :: ln_velavcur    !: Logical switch for raw daily averaged netCDF current meter vel. data  
     74   LOGICAL, PUBLIC :: ln_velhrcur    !: Logical switch for raw high freq netCDF current meter vel. data  
     75   LOGICAL, PUBLIC :: ln_velavadcp   !: Logical switch for raw daily averaged netCDF ADCP vel. data  
     76   LOGICAL, PUBLIC :: ln_velhradcp   !: Logical switch for raw high freq netCDF ADCP vel. data  
     77   LOGICAL, PUBLIC :: ln_velfb       !: Logical switch for velocities from feedback files 
     78   LOGICAL, PUBLIC :: ln_ssh         !: Logical switch for sea surface height 
     79   LOGICAL, PUBLIC :: ln_sss         !: Logical switch for sea surface salinity 
     80   LOGICAL, PUBLIC :: ln_nea         !: Remove observations near land 
     81   LOGICAL, PUBLIC :: ln_altbias     !: Logical switch for altimeter bias   
     82   LOGICAL, PUBLIC :: ln_ignmis      !: Logical switch for ignoring missing files 
     83   LOGICAL, PUBLIC :: ln_s_at_t      !: Logical switch to compute model S at T observations 
     84 
     85   REAL(KIND=dp), PUBLIC :: dobsini   !: Observation window start date YYYYMMDD.HHMMSS 
     86   REAL(KIND=dp), PUBLIC :: dobsend   !: Observation window end date YYYYMMDD.HHMMSS 
    8987   
    90    INTEGER, PUBLIC :: & 
    91       & n1dint,  &   !: Vertical interpolation method 
    92       & n2dint       !: Horizontal interpolation method  
     88   INTEGER, PUBLIC :: n1dint       !: Vertical interpolation method 
     89   INTEGER, PUBLIC :: n2dint       !: Horizontal interpolation method  
    9390 
    9491   INTEGER, DIMENSION(imaxavtypes) :: & 
    … …  
    170167         &            ln_velfb, velfbfiles, ln_velfb_av,              & 
    171168         &            ln_profb_enatim, ln_ignmis 
    172       INTEGER :: & 
    173          & jprofset,   & 
    174          & jveloset,   & 
    175          & jvar,       & 
    176          & jnumenact,  & 
    177          & jnumcorio,  & 
    178          & jnumprofb,  & 
    179          & jnumslaact, & 
    180          & jnumslapas, & 
    181          & jnumslafb,  & 
    182          & jnumsst,    & 
    183          & jnumsstfb,  & 
    184          & jnumseaice, & 
    185          & jnumvelavcur, & 
    186          & jnumvelhrcur, &    
    187          & jnumvelavadcp, & 
    188          & jnumvelhradcp, &    
    189          & jnumvelfb,  & 
    190          & ji,         & 
    191          & jset 
     169 
     170      INTEGER :: jprofset 
     171      INTEGER :: jveloset 
     172      INTEGER :: jvar 
     173      INTEGER :: jnumenact 
     174      INTEGER :: jnumcorio 
     175      INTEGER :: jnumprofb 
     176      INTEGER :: jnumslaact 
     177      INTEGER :: jnumslapas 
     178      INTEGER :: jnumslafb 
     179      INTEGER :: jnumsst 
     180      INTEGER :: jnumsstfb 
     181      INTEGER :: jnumseaice 
     182      INTEGER :: jnumvelavcur 
     183      INTEGER :: jnumvelhrcur   
     184      INTEGER :: jnumvelavadcp 
     185      INTEGER :: jnumvelhradcp    
     186      INTEGER :: jnumvelfb 
     187      INTEGER :: ji 
     188      INTEGER :: jset 
    192189      LOGICAL :: lmask(MaxNumFiles), ll_u3d, ll_v3d 
    193190 
    … …  
    263260         WHERE (enactfiles(:) /= '') lmask(:) = .TRUE. 
    264261         jnumenact = COUNT(lmask) 
    265       END IF 
     262      ENDIF 
    266263      IF (ln_cor) THEN 
    267264         lmask(:) = .FALSE. 
    268265         WHERE (coriofiles(:) /= '') lmask(:) = .TRUE. 
    269266         jnumcorio = COUNT(lmask) 
    270       END IF 
     267      ENDIF 
    271268      IF (ln_profb) THEN 
    272269         lmask(:) = .FALSE. 
    273270         WHERE (profbfiles(:) /= '') lmask(:) = .TRUE. 
    274271         jnumprofb = COUNT(lmask) 
    275       END IF 
     272      ENDIF 
    276273      IF (ln_sladt) THEN 
    277274         lmask(:) = .FALSE. 
    … …  
    281278         WHERE (slafilespas(:) /= '') lmask(:) = .TRUE. 
    282279         jnumslapas = COUNT(lmask) 
    283       END IF 
     280      ENDIF 
    284281      IF (ln_slafb) THEN 
    285282         lmask(:) = .FALSE. 
    … …  
    287284         jnumslafb = COUNT(lmask) 
    288285         lmask(:) = .FALSE. 
    289       END IF 
     286      ENDIF 
    290287      IF (ln_ghrsst) THEN 
    291288         lmask(:) = .FALSE. 
    292289         WHERE (sstfiles(:) /= '') lmask(:) = .TRUE. 
    293290         jnumsst = COUNT(lmask) 
    294       END IF       
     291      ENDIF       
    295292      IF (ln_sstfb) THEN 
    296293         lmask(:) = .FALSE. 
    … …  
    298295         jnumsstfb = COUNT(lmask) 
    299296         lmask(:) = .FALSE. 
    300       END IF 
     297      ENDIF 
    301298      IF (ln_seaice) THEN 
    302299         lmask(:) = .FALSE. 
    303300         WHERE (seaicefiles(:) /= '') lmask(:) = .TRUE. 
    304301         jnumseaice = COUNT(lmask) 
    305       END IF 
     302      ENDIF 
    306303      IF (ln_velavcur) THEN 
    307304         lmask(:) = .FALSE. 
    308305         WHERE (velavcurfiles(:) /= '') lmask(:) = .TRUE. 
    309306         jnumvelavcur = COUNT(lmask) 
    310       END IF 
     307      ENDIF 
    311308      IF (ln_velhrcur) THEN 
    312309         lmask(:) = .FALSE. 
    313310         WHERE (velhrcurfiles(:) /= '') lmask(:) = .TRUE. 
    314311         jnumvelhrcur = COUNT(lmask) 
    315       END IF 
     312      ENDIF 
    316313      IF (ln_velavadcp) THEN 
    317314         lmask(:) = .FALSE. 
    318315         WHERE (velavadcpfiles(:) /= '') lmask(:) = .TRUE. 
    319316         jnumvelavadcp = COUNT(lmask) 
    320       END IF 
     317      ENDIF 
    321318      IF (ln_velhradcp) THEN 
    322319         lmask(:) = .FALSE. 
    323320         WHERE (velhradcpfiles(:) /= '') lmask(:) = .TRUE. 
    324321         jnumvelhradcp = COUNT(lmask) 
    325       END IF 
     322      ENDIF 
    326323      IF (ln_velfb) THEN 
    327324         lmask(:) = .FALSE. 
    … …  
    329326         jnumvelfb = COUNT(lmask) 
    330327         lmask(:) = .FALSE. 
    331       END IF 
     328      ENDIF 
    332329       
    333330      ! Control print 
    … …  
    372369                  TRIM(enactfiles(ji)) 
    373370            END DO 
    374          END IF 
     371         ENDIF 
    375372         IF (ln_cor) THEN 
    376373            DO ji = 1, jnumcorio 
    … …  
    378375                  TRIM(coriofiles(ji)) 
    379376            END DO 
    380          END IF 
     377         ENDIF 
    381378         IF (ln_profb) THEN 
    382379            DO ji = 1, jnumprofb 
    … …  
    390387               WRITE(numout,'(1X,2A)') '       Enact feedback input time setting switch    ln_profb_enatim = ', ln_profb_enatim(ji) 
    391388            END DO 
    392          END IF 
     389         ENDIF 
    393390         IF (ln_sladt) THEN 
    394391            DO ji = 1, jnumslaact 
    … …  
    400397                  TRIM(slafilespas(ji)) 
    401398            END DO 
    402          END IF 
     399         ENDIF 
    403400         IF (ln_slafb) THEN 
    404401            DO ji = 1, jnumslafb 
    … …  
    406403                  TRIM(slafbfiles(ji)) 
    407404            END DO 
    408          END IF 
     405         ENDIF 
    409406         IF (ln_ghrsst) THEN 
    410407            DO ji = 1, jnumsst 
    … …  
    412409                  TRIM(sstfiles(ji)) 
    413410            END DO 
    414          END IF 
     411         ENDIF 
    415412         IF (ln_sstfb) THEN 
    416413            DO ji = 1, jnumsstfb 
    … …  
    418415                  TRIM(sstfbfiles(ji)) 
    419416            END DO 
    420          END IF 
     417         ENDIF 
    421418         IF (ln_seaice) THEN 
    422419            DO ji = 1, jnumseaice 
    … …  
    424421                  TRIM(seaicefiles(ji)) 
    425422            END DO 
    426          END IF 
     423         ENDIF 
    427424         IF (ln_velavcur) THEN 
    428425            DO ji = 1, jnumvelavcur 
    … …  
    430427                  TRIM(velavcurfiles(ji)) 
    431428            END DO 
    432          END IF 
     429         ENDIF 
    433430         IF (ln_velhrcur) THEN 
    434431            DO ji = 1, jnumvelhrcur 
    … …  
    436433                  TRIM(velhrcurfiles(ji)) 
    437434            END DO 
    438          END IF 
     435         ENDIF 
    439436         IF (ln_velavadcp) THEN 
    440437            DO ji = 1, jnumvelavadcp 
    … …  
    442439                  TRIM(velavadcpfiles(ji)) 
    443440            END DO 
    444          END IF 
     441         ENDIF 
    445442         IF (ln_velhradcp) THEN 
    446443            DO ji = 1, jnumvelhradcp 
    … …  
    448445                  TRIM(velhradcpfiles(ji)) 
    449446            END DO 
    450          END IF 
     447         ENDIF 
    451448         IF (ln_velfb) THEN 
    452449            DO ji = 1, jnumvelfb 
    … …  
    459456               ENDIF 
    460457            END DO 
    461          END IF 
     458         ENDIF 
    462459         WRITE(numout,*) '             Initial date in window YYYYMMDD.HHMMSS        dobsini = ', dobsini 
    463460         WRITE(numout,*) '             Final date in window YYYYMMDD.HHMMSS          dobsend = ', dobsend 
    … …  
    630627               ENDIF 
    631628                
    632             ENDDO 
     629            END DO 
    633630 
    634631         ENDIF 
    … …  
    734731                  &              ln_sla, ln_nea ) 
    735732 
    736             ENDDO                
     733            END DO                
    737734 
    738735         ENDIF 
    … …  
    841838                  &              ln_sst, ln_nea ) 
    842839 
    843             ENDDO                
     840            END DO                
    844841 
    845842         ENDIF 
    … …  
    869866         nseaiceextr = 0 
    870867          
    871          ! Set the number of sla data sets to 1 
     868         ! Set the number of data sets to 1 
    872869         nseaicesets = 1 
    873870 
    … …  
    10441041 
    10451042 
    1046             ENDDO 
     1043            END DO 
    10471044             
    10481045         ENDIF 
    … …  
    11041101 
    11051102      !! * Arguments 
    1106       INTEGER, INTENT(IN) :: & 
    1107          & kstp                         ! Current timestep 
     1103      INTEGER, INTENT(IN) :: kstp                         ! Current timestep 
    11081104      !! * Local declarations 
    11091105#if ! defined key_ice_lim 
    1110       REAL(wp), DIMENSION(jpi,jpj) :: & 
    1111          & frld 
    1112 #endif 
    1113       INTEGER :: & 
    1114          & idaystp,    &                ! Number of timesteps per day 
    1115          & jprofset,   &                ! Profile data set loop variable 
    1116          & jslaset,    &                ! SLA data set loop variable 
    1117          & jsstset,    &                ! SST data set loop variable 
    1118          & jseaiceset, &                ! sea ice data set loop variable 
    1119          & jveloset, &                  ! velocity profile data loop variable 
    1120          & jvar                         ! Variable number     
     1106      REAL(wp), DIMENSION(jpi,jpj) :: frld 
     1107#endif 
     1108      INTEGER :: idaystp                ! Number of timesteps per day 
     1109      INTEGER :: jprofset               ! Profile data set loop variable 
     1110      INTEGER :: jslaset                ! SLA data set loop variable 
     1111      INTEGER :: jsstset                ! SST data set loop variable 
     1112      INTEGER :: jseaiceset             ! sea ice data set loop variable 
     1113      INTEGER :: jveloset               ! velocity profile data loop variable 
     1114      INTEGER :: jvar                   ! Variable number     
    11211115      CHARACTER(LEN=20) :: datestr=" ",timestr=" " 
    11221116  
    … …  
    12311225 
    12321226      !! * Local declarations 
    1233       INTEGER :: & 
    1234          & jprofset, &                 ! Profile data set loop variable 
    1235          & jveloset, &                 ! Velocity data set loop variable 
    1236          & jslaset, &                  ! SLA data set loop variable 
    1237          & jsstset, &                  ! SST data set loop variable 
    1238          & jseaiceset                  ! Sea Ice data set loop variable 
    1239       INTEGER :: & 
    1240          & jset, & 
    1241          & jfbini 
     1227 
     1228      INTEGER :: jprofset                 ! Profile data set loop variable 
     1229      INTEGER :: jveloset                 ! Velocity data set loop variable 
     1230      INTEGER :: jslaset                  ! SLA data set loop variable 
     1231      INTEGER :: jsstset                  ! SST data set loop variable 
     1232      INTEGER :: jseaiceset               ! Sea Ice data set loop variable 
     1233      INTEGER :: jset 
     1234      INTEGER :: jfbini 
    12421235      CHARACTER(LEN=20) :: datestr=" ",timestr=" " 
    12431236      CHARACTER(LEN=10) :: cdtmp 
    … …  
    13021295               CALL obs_wri_p3d( cdtmp, profdata(jprofset) ) 
    13031296 
    1304             ENDDO 
     1297            END DO 
    13051298 
    13061299         ENDIF 
    … …  
    13421335               CALL obs_wri_sla( cdtmp, sladata(jslaset) ) 
    13431336 
    1344             ENDDO 
     1337            END DO 
    13451338 
    13461339         ENDIF 
    … …  
    13871380               CALL obs_wri_sst( cdtmp, sstdata(jsstset) ) 
    13881381 
    1389             ENDDO 
     1382            END DO 
    13901383 
    13911384         ENDIF 
    … …  
    14861479               CALL obs_wri_vel( cdtmp, velodata(jveloset), n2dint ) 
    14871480 
    1488             ENDDO 
     1481            END DO 
    14891482 
    14901483         ENDIF 
    … …  
    15281521 
    15291522      !! * Arguments 
    1530       REAL(KIND=dp), INTENT(OUT) :: & 
    1531          & ddobsini                         ! Initial date in YYYYMMDD.HHMMSS 
     1523      REAL(KIND=dp), INTENT(OUT) :: ddobsini                         ! Initial date in YYYYMMDD.HHMMSS 
    15321524 
    15331525      !! * Local declarations 
    1534       INTEGER ::        &      ! date 
    1535          & iyea,      &        !  - (year, month, day, hour, minute) 
    1536          & imon,      & 
    1537          & iday,      & 
    1538          & ihou,      & 
    1539          & imin 
     1526      INTEGER :: iyea        ! date - (year, month, day, hour, minute) 
     1527      INTEGER :: imon 
     1528      INTEGER :: iday 
     1529      INTEGER :: ihou 
     1530      INTEGER :: imin 
    15401531      INTEGER :: imday         ! Number of days in month. 
    15411532      REAL(KIND=wp) :: zdayfrc ! Fraction of day 
    … …  
    16131604 
    16141605      !! * Arguments 
    1615       REAL(KIND=dp), INTENT(OUT) :: & 
    1616          & ddobsfin                   ! Final date in YYYYMMDD.HHMMSS 
     1606      REAL(KIND=dp), INTENT(OUT) :: ddobsfin                   ! Final date in YYYYMMDD.HHMMSS 
    16171607 
    16181608      !! * Local declarations 
    1619       INTEGER ::   &     ! Date 
    1620          & iyea,   &     !  - (year, month, day, hour, minute) 
    1621          & imon,   &     
    1622          & iday,   &     
    1623          & ihou,   &     
    1624          & imin      
    1625       INTEGER :: & 
    1626          & imday         ! Number of days in month 
    1627       REAL(KIND=wp) :: & 
    1628          & zdayfrc       ! Fraction of day 
     1609      INTEGER :: iyea        ! date - (year, month, day, hour, minute) 
     1610      INTEGER :: imon 
     1611      INTEGER :: iday 
     1612      INTEGER :: ihou 
     1613      INTEGER :: imin 
     1614      INTEGER :: imday         ! Number of days in month. 
     1615      REAL(KIND=wp) :: zdayfrc       ! Fraction of day 
    16291616          
    16301617      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/find_obs_proc.h90

    r2001 r2074  
    1616 
    1717      !! * Arguments 
    18       INTEGER, INTENT(IN) :: & 
    19          & kldi,    &               ! Start of inner domain in i 
    20          & klei,    &               ! End of inner domain in i 
    21          & kldj,    &               ! Start of inner domain in j 
    22          & klej                     ! End of inner domain in j 
    23       INTEGER, INTENT(IN) :: & 
    24          & kmyproc, & 
    25          & kno 
    26       INTEGER, DIMENSION(kno), INTENT(IN) :: & 
    27          & kobsi, & 
    28          & kobsj 
    29       INTEGER, DIMENSION(kno), INTENT(INOUT) :: & 
    30          & kobsp 
     18 
     19      INTEGER, INTENT(IN) :: kldi               ! Start of inner domain in i 
     20      INTEGER, INTENT(IN) :: klei               ! End of inner domain in i 
     21      INTEGER, INTENT(IN) :: kldj               ! Start of inner domain in j 
     22      INTEGER, INTENT(IN) :: klej               ! End of inner domain in j 
     23 
     24      INTEGER, INTENT(IN) :: kmyproc 
     25      INTEGER, INTENT(IN) :: kno 
     26 
     27      INTEGER, DIMENSION(kno), INTENT(IN) :: kobsi 
     28      INTEGER, DIMENSION(kno), INTENT(IN) :: kobsj 
     29      INTEGER, DIMENSION(kno), INTENT(INOUT) :: kobsp 
    3130       
    3231      !! * local variables 
    … …  
    4746            kobsp(ji)=1000000 
    4847         ENDIF 
    49       ENDDO 
     48      END DO 
    5049 
    5150      ! Ensure that observations not in processor are masked 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/grt_cir_dis.h90

    r2001 r2074  
    1515       
    1616      !! * Arguments 
    17       REAL(KIND=wp) ::& 
    18          & pa1, &  !  sin(lat1) 
    19          & pa2, &  !  sin(lat2) 
    20          & pb1, &  !  cos(lat1) * cos(lon1) 
    21          & pb2, &  !  cos(lat2) * cos(lon2) 
    22          & pc1, &  !  cos(lat1) * sin(lon1) 
    23          & pc2     !  cos(lat2) * sin(lon2) 
     17      REAL(KIND=wp) :: pa1   !  sin(lat1) 
     18      REAL(KIND=wp) :: pa2   !  sin(lat2) 
     19      REAL(KIND=wp) :: pb1   !  cos(lat1) * cos(lon1) 
     20      REAL(KIND=wp) :: pb2   !  cos(lat2) * cos(lon2) 
     21      REAL(KIND=wp) :: pc1   !  cos(lat1) * sin(lon1) 
     22      REAL(KIND=wp) :: pc2   !  cos(lat2) * sin(lon2) 
    2423 
    2524      grt_cir_dis = & 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/grt_cir_dis_saa.h90

    r2001 r2074  
    1717       
    1818      !! * Arguments 
    19       REAL(KIND=wp) :: & 
    20          & pa, & !  lon1 - lon2 
    21          & pb, & !  lat1 - lat2 
    22          & pc    !  cos(lat2) 
     19      REAL(KIND=wp) :: pa   !  lon1 - lon2 
     20      REAL(KIND=wp) :: pb   !  lat1 - lat2 
     21      REAL(KIND=wp) :: pc   !  cos(lat2) 
    2322 
    2423      grt_cir_dis_saa = SQRT( pa * pa + ( pb * pc )**2 ) 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/linquad.h90

    r2001 r2074  
    1818 
    1919      !! * Arguments 
    20       REAL(KIND=wp), INTENT(IN) :: & 
    21          & px,   &                  ! (lon, lat) of the point P(x,y)  
    22          & py                        
     20      REAL(KIND=wp), INTENT(IN) :: px        ! (lon) of the point P(x,y)  
     21      REAL(KIND=wp), INTENT(IN) :: py        ! (lat) of the point P(x,y)                
    2322      REAL(KIND=wp), DIMENSION(4), INTENT(IN) :: & 
    2423         & pxv,  &                  ! (lon, lat) of the surrounding cell 
    … …  
    2625   
    2726      !! * Local declarations 
    28       REAL(KIND=wp) :: & 
    29          & zst1, & 
    30          & zst2, & 
    31          & zst3, & 
    32          & zst4 
     27      REAL(KIND=wp) :: zst1 
     28      REAL(KIND=wp) :: zst2 
     29      REAL(KIND=wp) :: zst3 
     30      REAL(KIND=wp) :: zst4 
    3331 
    3432      !----------------------------------------------------------------------- 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/maxdist.h90

    r2001 r2074  
    2727          &  zb,  & 
    2828          &  zc 
    29       REAL(KIND=wp) :: & 
    30           &  zdist 
    31       INTEGER :: & 
    32           &  ji,  & 
    33           &  jj 
     29      REAL(KIND=wp) :: zdist 
     30       
     31      INTEGER :: ji 
     32      INTEGER :: jj 
    3433       
    3534      !----------------------------------------------------------------------- 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/mpp_map.F90

    r2001 r2074  
    6363 
    6464      !! * Arguments 
    65       INTEGER, DIMENSION(:,:), ALLOCATABLE :: & 
    66          & imppmap 
     65      INTEGER, DIMENSION(:,:), ALLOCATABLE :: imppmap 
    6766#if defined key_mpp_mpi 
    6867      !! * Local declarations 
    69       INTEGER :: & 
    70          & ierr 
     68      INTEGER :: ierr 
    7169#     include <mpif.h> 
    7270#endif 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_conv.h90

    r2001 r2074  
    2323 
    2424      !! * Arguments 
    25       REAL(KIND=wp), INTENT(IN) :: & 
    26          & ps, & 
    27          & pt, & 
    28          & pp, & 
    29          & ppr 
    30  
    31       !! * Local declarations 
    32       REAL(KIND=wp) :: & 
    33          & zpol 
    34       REAL(KIND=wp), PARAMETER :: & 
    35          & a1 =  1.067610e-05, & 
    36          & a2 = -1.434297e-06, & 
    37          & a3 = -7.566349e-09, & 
    38          & a4 = -8.535585e-06, & 
    39          & a5 =  3.074672e-08, & 
    40          & a6 =  1.918639e-08, & 
    41          & a7 =  1.788718e-10 
     25 
     26      REAL(KIND=wp), INTENT(IN) :: ps 
     27      REAL(KIND=wp), INTENT(IN) :: pt 
     28      REAL(KIND=wp), INTENT(IN) :: pp 
     29      REAL(KIND=wp), INTENT(IN) :: ppr 
     30 
     31      !! * Local declarations 
     32      REAL(KIND=wp) :: zpol 
     33      REAL(KIND=wp), PARAMETER :: a1 =  1.067610e-05 
     34      REAL(KIND=wp), PARAMETER :: a2 = -1.434297e-06 
     35      REAL(KIND=wp), PARAMETER :: a3 = -7.566349e-09 
     36      REAL(KIND=wp), PARAMETER :: a4 = -8.535585e-06 
     37      REAL(KIND=wp), PARAMETER :: a5 =  3.074672e-08 
     38      REAL(KIND=wp), PARAMETER :: a6 =  1.918639e-08 
     39      REAL(KIND=wp), PARAMETER :: a7 =  1.788718e-10 
    4240 
    4341      zpol = a1 + a2 * ps + a3 * ( pp + ppr ) + a4 * pt & 
    … …  
    6765 
    6866      !! * Arguments 
    69       REAL(KIND=wp) :: & 
    70          & pft, &  ! in situ temperature in degrees celcius 
    71          & pfs, &  ! salinity in psu 
    72          & pfp     ! pressure in bars 
     67      REAL(KIND=wp) :: pft   ! in situ temperature in degrees celcius 
     68      REAL(KIND=wp) :: pfs   ! salinity in psu 
     69      REAL(KIND=wp) :: pfp   ! pressure in bars 
    7370       
    7471      fspott = & 
    … …  
    110107 
    111108      !! * Arguments 
    112       REAL(KIND=wp), INTENT(IN) ::  & 
    113          & p_s, &    ! Salinity in PSU 
    114          & p_t, &    ! Temperature in centigrades 
    115          & p_p       ! Pressure in decibars. 
     109 
     110      REAL(KIND=wp), INTENT(IN) :: p_s    ! Salinity in PSU 
     111      REAL(KIND=wp), INTENT(IN) :: p_t    ! Temperature in centigrades 
     112      REAL(KIND=wp), INTENT(IN) :: p_p    ! Pressure in decibars. 
    116113 
    117114      !! * Local declarations 
    … …  
    150147 
    151148      !! * Arguments 
    152       REAL(KIND=wp), INTENT(IN) :: & 
    153          & p_s,  & 
    154          & p_t0, & 
    155          & p_p0, & 
    156          & p_pr 
    157  
    158       !! * Local declarations 
    159       REAL(KIND=wp) :: & 
    160          & z_p,  & 
    161          & z_t,  & 
    162          & z_h,  & 
    163          & z_xk, & 
    164          & z_q 
     149      REAL(KIND=wp), INTENT(IN) :: p_s 
     150      REAL(KIND=wp), INTENT(IN) :: p_t0 
     151      REAL(KIND=wp), INTENT(IN) :: p_p0 
     152      REAL(KIND=wp), INTENT(IN) :: p_pr 
     153 
     154      !! * Local declarations 
     155      REAL(KIND=wp) :: z_p 
     156      REAL(KIND=wp) :: z_t 
     157      REAL(KIND=wp) :: z_h 
     158      REAL(KIND=wp) :: z_xk 
     159      REAL(KIND=wp) :: z_q 
    165160 
    166161      z_p = p_p0 
    … …  
    205200 
    206201      !! * Arguments 
    207       REAL(KIND=wp), INTENT(IN) :: & 
    208          & p_p, &   ! Pressure in decibars 
    209          & p_lat    ! Latitude in degrees 
    210  
    211       !! * Local declarations 
    212       REAL(KIND=wp) :: & 
    213          & z_x, & 
    214          & z_gr 
     202      REAL(KIND=wp), INTENT(IN) :: p_p     ! Pressure in decibars 
     203      REAL(KIND=wp), INTENT(IN) :: p_lat   ! Latitude in degrees 
     204 
     205      !! * Local declarations 
     206      REAL(KIND=wp) :: z_x 
     207      REAL(KIND=wp) :: z_gr 
    215208       
    216209      z_x = SIN( p_lat / 57.29578 ) 
    … …  
    242235 
    243236      !! * Arguments 
    244       REAL(KIND=wp), INTENT(IN) :: & 
    245          & p_p, &   ! Pressure in decibars 
    246          & p_lat    ! Latitude in degrees 
    247  
    248       !! * Local declarations 
    249       REAL(KIND=wp) :: & 
    250          & z_x,  & 
    251          & z_c1, & 
    252          & z_c2 
     237      REAL(KIND=wp), INTENT(IN) :: p_p    ! Pressure in decibars 
     238      REAL(KIND=wp), INTENT(IN) :: p_lat  ! Latitude in degrees 
     239 
     240      !! * Local declarations 
     241      REAL(KIND=wp) :: z_x 
     242      REAL(KIND=wp) :: z_c1 
     243      REAL(KIND=wp) :: z_c2 
    253244 
    254245      z_x = SIN( p_lat / 57.29578 ) 
    … …  
    279270 
    280271      !! * Arguments 
    281       REAL(KIND=wp), INTENT(IN) :: & 
    282          & p_dep, & ! Depth in meters 
    283          & p_lat    ! Latitude in degrees 
    284  
    285       !! * Local declarations 
    286       REAL(KIND=wp) :: & 
    287          & z_x,  & 
    288          & z_c1, & 
    289          & z_c2, & 
    290          & z_d 
     272      REAL(KIND=wp), INTENT(IN) :: p_dep    ! Depth in meters 
     273      REAL(KIND=wp), INTENT(IN) :: p_lat    ! Latitude in degrees 
     274 
     275      !! * Local declarations 
     276      REAL(KIND=wp) :: z_x 
     277      REAL(KIND=wp) :: z_c1 
     278      REAL(KIND=wp) :: z_c2 
     279      REAL(KIND=wp) :: z_d 
    291280 
    292281      z_x = SIN( p_lat / 57.29578 ) 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_fbm.F90

    r2001 r2074  
    4949 
    5050   TYPE obfbdata 
    51       LOGICAL :: & 
    52          & lalloc, &            !: Allocation status for data 
    53          & lgrid                !: Include grid search info 
    54       INTEGER :: & 
    55          & nvar, &              !: Number of variables 
    56          & nobs, &              !: Number of observations 
    57          & nlev, &              !: Number of levels 
    58          & nadd, &              !: Number of additional entries 
    59          & next, &              !: Number of extra variables 
    60          & nqcf                 !: Number of words per qc flag 
     51      LOGICAL :: lalloc         !: Allocation status for data 
     52      LOGICAL :: lgrid          !: Include grid search info 
     53      INTEGER :: nvar           !: Number of variables 
     54      INTEGER :: nobs           !: Number of observations 
     55      INTEGER :: nlev           !: Number of levels 
     56      INTEGER :: nadd           !: Number of additional entries 
     57      INTEGER :: next           !: Number of extra variables 
     58      INTEGER :: nqcf           !: Number of words per qc flag 
    6159      CHARACTER(LEN=ilenwmo), DIMENSION(:), POINTER :: & 
    6260         & cdwmo                !: Identifier 
    … …  
    143141      !!---------------------------------------------------------------------- 
    144142      !! * Arguments 
    145       TYPE(obfbdata) :: & 
    146          & fbdata      ! obsfbdata structure 
     143      TYPE(obfbdata) :: fbdata      ! obsfbdata structure 
    147144 
    148145      fbdata%nvar   = 0 
    … …  
    170167      !!---------------------------------------------------------------------- 
    171168      !! * Arguments 
    172       TYPE(obfbdata) :: & 
    173          & fbdata                   ! obsfbdata structure to be allocated 
    174       INTEGER, INTENT(IN) :: & 
    175          & kvar, &                  ! Number of variables 
    176          & kobs, &                  ! Number of observations 
    177          & klev, &                  ! Number of levels 
    178          & kadd, &                  ! Number of additional entries 
    179          & kext                     ! Number of extra variables 
    180       LOGICAL, INTENT(IN) :: & 
    181          & lgrid                    ! Include grid search information 
    182       INTEGER, OPTIONAL :: & 
    183          & kqcf                     ! Number of words for QC flags 
     169      TYPE(obfbdata) ::  fbdata          ! obsfbdata structure to be allocated 
     170      INTEGER, INTENT(IN) :: kvar        ! Number of variables 
     171      INTEGER, INTENT(IN) :: kobs        ! Number of observations 
     172      INTEGER, INTENT(IN) :: klev        ! Number of levels 
     173      INTEGER, INTENT(IN) :: kadd        ! Number of additional entries 
     174      INTEGER, INTENT(IN) :: kext        ! Number of extra variables 
     175      LOGICAL, INTENT(IN) :: lgrid       ! Include grid search information 
     176      INTEGER, OPTIONAL ::  kqcf         ! Number of words for QC flags 
    184177      !! * Local variables 
    185       INTEGER :: & 
    186          & ji, & 
    187          & jv 
     178      INTEGER :: ji 
     179      INTEGER :: jv 
    188180 
    189181      ! Check allocation status and deallocate previous allocated structures 
    … …  
    365357      !!---------------------------------------------------------------------- 
    366358      !! * Arguments 
    367       TYPE(obfbdata) :: & 
    368          & fbdata      ! obsfbdata structure 
     359      TYPE(obfbdata) :: fbdata      ! obsfbdata structure 
    369360 
    370361      ! Deallocate data  
    … …  
    490481      !!---------------------------------------------------------------------- 
    491482      !! * Arguments 
    492       TYPE(obfbdata) :: & 
    493          & fbdata1, &            ! Input obsfbdata structure 
    494          & fbdata2               ! Output obsfbdata structure 
    495       INTEGER, INTENT(IN), OPTIONAL :: & 
    496          & kadd, &               ! Number of additional entries 
    497          & kext, &               ! Number of extra variables 
    498          & kqcf                  ! Number of words per qc flags 
    499       LOGICAL, OPTIONAL ::  & 
    500          & lgrid                 ! Grid info on output file 
     483      TYPE(obfbdata) :: fbdata1               ! Input obsfbdata structure 
     484      TYPE(obfbdata) :: fbdata2               ! Output obsfbdata structure 
     485      INTEGER, INTENT(IN), OPTIONAL :: kadd   ! Number of additional entries 
     486      INTEGER, INTENT(IN), OPTIONAL :: kext   ! Number of extra variables 
     487      INTEGER, INTENT(IN), OPTIONAL :: kqcf   ! Number of words per qc flags 
     488      LOGICAL, OPTIONAL :: lgrid              ! Grid info on output file 
     489 
    501490      !! * Local variables 
    502       INTEGER :: & 
    503          & nadd, & 
    504          & next, & 
    505          & nqcf 
    506       LOGICAL :: & 
    507          & llgrid 
    508       INTEGER :: & 
    509          & jv, & 
    510          & je, & 
    511          & ji, & 
    512          & jk, & 
    513          & jq 
     491      INTEGER :: nadd 
     492      INTEGER :: next 
     493      INTEGER :: nqcf 
     494      LOGICAL :: llgrid 
     495      INTEGER :: jv 
     496      INTEGER :: je 
     497      INTEGER :: ji 
     498      INTEGER :: jk 
     499      INTEGER :: jq 
    514500 
    515501      ! Check allocation status of fbdata1 
    … …  
    621607            fbdata2%ipqcf(jq,ji)  = fbdata1%ipqcf(jq,ji) 
    622608            fbdata2%itqcf(jq,ji)  = fbdata1%itqcf(jq,ji) 
    623          ENDDO 
     609         END DO 
    624610         DO jk = 1, fbdata1%nlev 
    625611            fbdata2%idqc(jk,ji)  = fbdata1%idqc(jk,ji) 
    … …  
    627613            DO jq = 1, fbdata1%nqcf 
    628614               fbdata2%idqcf(jq,jk,ji) = fbdata1%idqcf(jq,jk,ji) 
    629             ENDDO 
    630          ENDDO 
    631       ENDDO 
     615            END DO 
     616         END DO 
     617      END DO 
    632618 
    633619      ! Copy the variable data 
    … …  
    641627            DO jq = 1, fbdata1%nqcf 
    642628               fbdata2%ivqcf(jq,ji,jv) = fbdata1%ivqcf(jq,ji,jv) 
    643             ENDDO 
     629            END DO 
    644630            DO jk = 1, fbdata1%nlev 
    645631               fbdata2%ivlqc(jk,ji,jv)  = fbdata1%ivlqc(jk,ji,jv) 
    … …  
    647633               DO jq = 1, fbdata1%nqcf 
    648634                  fbdata2%ivlqcf(jq,jk,ji,jv) = fbdata1%ivlqcf(jq,jk,ji,jv) 
    649                ENDDO 
    650             ENDDO 
    651          ENDDO 
    652       ENDDO 
     635               END DO 
     636            END DO 
     637         END DO 
     638      END DO 
    653639 
    654640      ! Copy grid information 
    … …  
    663649               DO jk = 1, fbdata1%nlev 
    664650                  fbdata2%iobsk(jk,ji,jv)  = fbdata1%iobsk(jk,ji,jv) 
    665                ENDDO 
    666             ENDDO 
    667          ENDDO 
     651               END DO 
     652            END DO 
     653         END DO 
    668654      ENDIF 
    669655 
    … …  
    672658      DO je = 1, MIN( fbdata1%nadd, fbdata2%nadd ) 
    673659         fbdata2%caddname(je) = fbdata1%caddname(je) 
    674       ENDDO 
     660      END DO 
    675661      DO jv = 1, fbdata1%nvar 
    676662         DO je = 1, MIN( fbdata1%nadd, fbdata2%nadd ) 
    … …  
    680666               DO jk = 1, fbdata1%nlev 
    681667                  fbdata2%padd(jk,ji,je,jv) = fbdata1%padd(jk,ji,je,jv) 
    682                ENDDO 
    683             ENDDO 
    684          ENDDO 
    685       ENDDO 
     668               END DO 
     669            END DO 
     670         END DO 
     671      END DO 
    686672       
    687673      ! Copy extra information 
    … …  
    691677         fbdata2%cextlong(je) = fbdata1%cextlong(je) 
    692678         fbdata2%cextunit(je) = fbdata1%cextunit(je) 
    693       ENDDO 
     679      END DO 
    694680      DO je = 1, fbdata1%next 
    695681         DO ji = 1, fbdata1%nobs 
    696682            DO jk = 1, fbdata1%nlev 
    697683               fbdata2%pext(jk,ji,je) = fbdata1%pext(jk,ji,je) 
    698             ENDDO 
    699          ENDDO 
    700       ENDDO 
     684            END DO 
     685         END DO 
     686      END DO 
    701687 
    702688   END SUBROUTINE copy_obfbdata 
    … …  
    716702      !!---------------------------------------------------------------------- 
    717703      !! * Arguments 
    718       TYPE(obfbdata) :: & 
    719          & fbdata1, &            ! Input obsfbdata structure 
    720          & fbdata2               ! Output obsfbdata structure 
    721       LOGICAL, DIMENSION(fbdata1%nobs) :: & 
    722          & llvalid               ! Grid info on output file 
     704      TYPE(obfbdata) :: fbdata1           ! Input obsfbdata structure 
     705      TYPE(obfbdata) :: fbdata2           ! Output obsfbdata structure 
     706      LOGICAL, DIMENSION(fbdata1%nobs) :: llvalid     ! Grid info on output file 
    723707      !! * Local variables 
    724       INTEGER :: & 
    725          & nobs 
    726       INTEGER :: & 
    727          & jv, & 
    728          & je, & 
    729          & ji, & 
    730          & jk, & 
    731          & jq, & 
    732          & ij 
     708      INTEGER :: nobs 
     709      INTEGER :: jv 
     710      INTEGER :: je 
     711      INTEGER :: ji 
     712      INTEGER :: jk 
     713      INTEGER :: jq 
     714      INTEGER :: ij 
    733715 
    734716      ! Check allocation status of fbdata1 
    … …  
    777759               fbdata2%ipqcf(jq,ij)  = fbdata1%ipqcf(jq,ji) 
    778760               fbdata2%itqcf(jq,ij)  = fbdata1%itqcf(jq,ji) 
    779             ENDDO 
     761            END DO 
    780762            DO jk = 1, fbdata1%nlev 
    781763               fbdata2%idqc(jk,ij)  = fbdata1%idqc(jk,ji) 
    … …  
    783765               DO jq = 1, fbdata1%nqcf 
    784766                  fbdata2%idqcf(jq,jk,ij) = fbdata1%idqcf(jq,jk,ji) 
    785                ENDDO 
    786             ENDDO 
    787          ENDIF 
    788       ENDDO 
     767               END DO 
     768            END DO 
     769         ENDIF 
     770      END DO 
    789771 
    790772      ! Copy the variable data 
    … …  
    801783               DO jq = 1, fbdata1%nqcf 
    802784                  fbdata2%ivqcf(jq,ij,jv) = fbdata1%ivqcf(jq,ji,jv) 
    803                ENDDO 
     785               END DO 
    804786               DO jk = 1, fbdata1%nlev 
    805787                  fbdata2%ivlqc(jk,ij,jv)  = fbdata1%ivlqc(jk,ji,jv) 
    … …  
    807789                  DO jq = 1, fbdata1%nqcf 
    808790                     fbdata2%ivlqcf(jq,jk,ij,jv) = fbdata1%ivlqcf(jq,jk,ji,jv) 
    809                   ENDDO 
    810                ENDDO 
     791                  END DO 
     792               END DO 
    811793            ENDIF 
    812          ENDDO 
    813       ENDDO 
     794         END DO 
     795      END DO 
    814796 
    815797      ! Copy grid information 
    … …  
    827809                  DO jk = 1, fbdata1%nlev 
    828810                     fbdata2%iobsk(jk,ij,jv)  = fbdata1%iobsk(jk,ji,jv) 
    829                   ENDDO 
     811                  END DO 
    830812               ENDIF 
    831             ENDDO 
    832          ENDDO 
     813            END DO 
     814         END DO 
    833815      ENDIF 
    834816 
    … …  
    837819      DO je = 1, fbdata1%nadd 
    838820         fbdata2%caddname(je) = fbdata1%caddname(je) 
    839       ENDDO 
     821      END DO 
    840822      DO jv = 1, fbdata1%nvar 
    841823         DO je = 1, fbdata1%nadd 
    … …  
    848830                  DO jk = 1, fbdata1%nlev 
    849831                     fbdata2%padd(jk,ij,je,jv) = fbdata1%padd(jk,ji,je,jv) 
    850                   ENDDO 
     832                  END DO 
    851833               ENDIF 
    852             ENDDO 
    853          ENDDO 
    854       ENDDO 
     834            END DO 
     835         END DO 
     836      END DO 
    855837       
    856838      ! Copy extra information 
    … …  
    860842         fbdata2%cextlong(je) = fbdata1%cextlong(je) 
    861843         fbdata2%cextunit(je) = fbdata1%cextunit(je) 
    862       ENDDO 
     844      END DO 
    863845      DO je = 1, fbdata1%next 
    864846         ij = 0 
    … …  
    868850               DO jk = 1, fbdata1%nlev 
    869851                  fbdata2%pext(jk,ij,je) = fbdata1%pext(jk,ji,je) 
    870                ENDDO 
     852               END DO 
    871853            ENDIF 
    872          ENDDO 
    873       ENDDO 
     854         END DO 
     855      END DO 
    874856 
    875857   END SUBROUTINE subsamp_obfbdata 
    … …  
    892874      !!---------------------------------------------------------------------- 
    893875      !! * Arguments 
    894       INTEGER, INTENT(IN):: & 
    895          & nsets                ! Number of input data sets  
    896       TYPE(obfbdata), DIMENSION(nsets) :: & 
    897          & fbdatain             ! Input obsfbdata structure 
    898       TYPE(obfbdata) ::  & 
    899          & fbdataout            ! Output obsfbdata structure 
     876      INTEGER, INTENT(IN):: nsets      ! Number of input data sets  
     877      TYPE(obfbdata), DIMENSION(nsets) :: fbdatain  ! Input obsfbdata structure 
     878      TYPE(obfbdata) :: fbdataout      ! Output obsfbdata structure 
    900879      INTEGER, INTENT(IN), DIMENSION(fbdataout%nobs) :: & 
    901880         & iset                 ! Set number for a given obs. 
    … …  
    905884         & iind                 ! Indices for copying. 
    906885      !! * Local variables 
    907       INTEGER :: & 
    908          & js, & 
    909          & jo, & 
    910          & jv, & 
    911          & je, & 
    912          & ji, & 
    913          & jk, & 
    914          & jq 
     886 
     887      INTEGER :: js 
     888      INTEGER :: jo 
     889      INTEGER :: jv 
     890      INTEGER :: je 
     891      INTEGER :: ji 
     892      INTEGER :: jk 
     893      INTEGER :: jq 
    915894 
    916895      ! Check allocation status of fbdatain  
    … …  
    921900               &              __LINE__ ) 
    922901         ENDIF 
    923       ENDDO 
     902      END DO 
    924903 
    925904      ! Check allocation status of fbdataout 
    … …  
    978957            fbdataout%ipqcf(jq,jo)  = fbdatain(js)%ipqcf(jq,ji) 
    979958            fbdataout%itqcf(jq,jo)  = fbdatain(js)%itqcf(jq,ji) 
    980          ENDDO 
     959         END DO 
    981960         DO jk = 1, fbdatain(js)%nlev 
    982961            fbdataout%pdep(jk,jo)  = fbdatain(js)%pdep(jk,ji) 
    … …  
    984963            DO jq = 1, fbdatain(js)%nqcf 
    985964               fbdataout%idqcf(jq,jk,jo) = fbdatain(js)%idqcf(jq,jk,ji) 
    986             ENDDO 
    987          ENDDO 
     965            END DO 
     966         END DO 
    988967 
    989968         ! Merge the variable data 
    … …  
    993972            DO jq = 1, fbdatain(js)%nqcf 
    994973               fbdataout%ivqcf(jq,jo,jv) = fbdatain(js)%ivqcf(jq,ji,jv) 
    995             ENDDO 
     974            END DO 
    996975            DO jk = 1, fbdatain(js)%nlev 
    997976               fbdataout%ivlqc(jk,jo,jv)  = fbdatain(js)%ivlqc(jk,ji,jv) 
    … …  
    1000979                  fbdataout%ivlqcf(jq,jk,jo,jv) = & 
    1001980                     &                     fbdatain(js)%ivlqcf(jq,jk,ji,jv) 
    1002                ENDDO 
    1003             ENDDO 
    1004          ENDDO 
     981               END DO 
     982            END DO 
     983         END DO 
    1005984 
    1006985         ! Merge grid information 
    … …  
    1014993               DO jk = 1, fbdatain(js)%nlev 
    1015994                  fbdataout%iobsk(jk,jo,jv)  = fbdatain(js)%iobsk(jk,ji,jv) 
    1016                ENDDO 
    1017             ENDDO 
     995               END DO 
     996            END DO 
    1018997         ENDIF 
    1019998 
    … …  
    10241003               DO jk = 1, fbdatain(js)%nlev 
    10251004                  fbdataout%padd(jk,jo,je,jv) = fbdatain(js)%padd(jk,ji,je,jv) 
    1026                ENDDO 
    1027             ENDDO 
    1028          ENDDO 
     1005               END DO 
     1006            END DO 
     1007         END DO 
    10291008          
    10301009         ! Merge extra information 
    … …  
    10331012            DO jk = 1, fbdatain(js)%nlev 
    10341013               fbdataout%pext(jk,jo,je) = fbdatain(js)%pext(jk,ji,je) 
    1035             ENDDO 
    1036          ENDDO 
    1037  
    1038       ENDDO 
     1014            END DO 
     1015         END DO 
     1016 
     1017      END DO 
    10391018 
    10401019   END SUBROUTINE merge_obfbdata 
    … …  
    10521031      !!---------------------------------------------------------------------- 
    10531032      !! * Arguments 
    1054       CHARACTER(len=*) :: & 
    1055          & cdfilename ! Output filename 
    1056       TYPE(obfbdata)   :: & 
    1057          & fbdata     ! obsfbdata structure 
     1033      CHARACTER(len=*) :: cdfilename ! Output filename 
     1034      TYPE(obfbdata)   :: fbdata     ! obsfbdata structure 
    10581035      !! * Local variables 
    1059       CHARACTER(LEN=14), PARAMETER :: & 
    1060          & cpname = 'write_obfbdata' 
    1061       INTEGER :: &    ! Dimension ids 
    1062          & idfile,  & 
    1063          & idodim,  & 
    1064          & idldim,  & 
    1065          & idvdim,  & 
    1066          & idadim,  & 
    1067          & idedim,  & 
    1068          & idsndim, & 
    1069          & idsgdim, & 
    1070          & idswdim, & 
    1071          & idstdim, & 
    1072          & idjddim, & 
    1073          & idqcdim 
    1074       INTEGER :: & 
    1075          & idvard,  & 
    1076          & idaddd,  & 
    1077          & idextd,  & 
    1078          & idcdwmo, & 
    1079          & idcdtyp, & 
    1080          & idplam,  & 
    1081          & idpphi,  & 
    1082          & idpdep,  & 
    1083          & idptim,  & 
    1084          & idptimr, & 
    1085          & idioqc,  &          
    1086          & idioqcf, &          
    1087          & idipqc,  & 
    1088          & idipqcf, & 
    1089          & iditqc,  & 
    1090          & iditqcf, & 
    1091          & ididqc,  & 
    1092          & ididqcf, & 
    1093          & idkindex 
     1036      CHARACTER(LEN=14), PARAMETER :: cpname = 'write_obfbdata' 
     1037      ! Dimension ids 
     1038      INTEGER :: idfile 
     1039      INTEGER :: idodim 
     1040      INTEGER :: idldim 
     1041      INTEGER :: idvdim 
     1042      INTEGER :: idadim 
     1043      INTEGER :: idedim 
     1044      INTEGER :: idsndim 
     1045      INTEGER :: idsgdim 
     1046      INTEGER :: idswdim 
     1047      INTEGER :: idstdim 
     1048      INTEGER :: idjddim 
     1049      INTEGER :: idqcdim 
     1050      INTEGER :: idvard 
     1051      INTEGER :: idaddd 
     1052      INTEGER :: idextd 
     1053      INTEGER :: idcdwmo 
     1054      INTEGER :: idcdtyp 
     1055      INTEGER :: idplam 
     1056      INTEGER :: idpphi 
     1057      INTEGER :: idpdep 
     1058      INTEGER :: idptim 
     1059      INTEGER :: idptimr 
     1060      INTEGER :: idioqc          
     1061      INTEGER :: idioqcf          
     1062      INTEGER :: idipqc 
     1063      INTEGER :: idipqcf 
     1064      INTEGER :: iditqc 
     1065      INTEGER :: iditqcf 
     1066      INTEGER :: ididqc 
     1067      INTEGER :: ididqcf 
     1068      INTEGER :: idkindex 
    10941069      INTEGER, DIMENSION(fbdata%nvar) :: & 
    10951070         & idpob,    & 
    … …  
    11021077         & idiobsk,  & 
    11031078         & idcgrid 
    1104       INTEGER, DIMENSION(fbdata%nadd,fbdata%nvar) :: & 
    1105          & idpadd 
    1106       INTEGER, DIMENSION(fbdata%next) :: & 
    1107          & idpext 
    1108       INTEGER, DIMENSION(1) :: & 
    1109          & incdim1 
    1110       INTEGER, DIMENSION(2) :: & 
    1111          & incdim2 
    1112       INTEGER, DIMENSION(3) :: & 
    1113          & incdim3 
    1114       INTEGER, DIMENSION(4) :: & 
    1115          & incdim4 
    1116       INTEGER :: & 
    1117          & jv, & 
    1118          & je 
    1119       INTEGER :: & 
    1120          & ioldfill 
     1079      INTEGER, DIMENSION(fbdata%nadd,fbdata%nvar) :: idpadd 
     1080      INTEGER, DIMENSION(fbdata%next) :: idpext 
     1081      INTEGER, DIMENSION(1) :: incdim1 
     1082      INTEGER, DIMENSION(2) :: incdim2 
     1083      INTEGER, DIMENSION(3) :: incdim3 
     1084      INTEGER, DIMENSION(4) :: incdim4 
     1085 
     1086      INTEGER :: jv 
     1087      INTEGER :: je 
     1088      INTEGER :: ioldfill 
    11211089      CHARACTER(len=nf90_max_name) :: & 
    11221090         & cdtmp 
    … …  
    13471315                  &                      cdunits =  fbdata%caddunit(je,jv), & 
    13481316                  &                      rfillvalue = fbrmdi ) 
    1349             ENDDO 
     1317            END DO 
    13501318         ENDIF 
    13511319 
    … …  
    14231391         ENDIF 
    14241392 
    1425       ENDDO 
     1393      END DO 
    14261394 
    14271395      IF ( fbdata%next > 0 ) THEN 
    … …  
    14371405               &                      cdunits =  fbdata%cextunit(je), & 
    14381406               &                      rfillvalue = fbrmdi ) 
    1439          ENDDO 
     1407         END DO 
    14401408      ENDIF 
    14411409       
    … …  
    15051473                     &                       fbdata%padd(:,:,je,jv) ), & 
    15061474                     &         cpname, __LINE__ ) 
    1507                ENDDO 
     1475               END DO 
    15081476            ENDIF 
    15091477            CALL chkerr( nf90_put_var( idfile, idivqc(jv), & 
    … …  
    15331501                  &         cpname, __LINE__ ) 
    15341502            ENDIF 
    1535          ENDDO 
     1503         END DO 
    15361504 
    15371505         IF ( fbdata%next > 0 ) THEN 
    … …  
    15401508                  &                       fbdata%pext(:,:,je) ), & 
    15411509                  &         cpname, __LINE__ ) 
    1542             ENDDO 
     1510            END DO 
    15431511         ENDIF 
    15441512 
    … …  
    15661534      !!---------------------------------------------------------------------- 
    15671535      !! * Arguments 
    1568       INTEGER :: & 
    1569          & idfile, &   ! File netcdf id. 
    1570          & idvar       ! Variable netcdf id. 
    1571       CHARACTER(len=*) :: & 
    1572          & cdlongname  ! Long name for variable 
    1573       CHARACTER(len=*), OPTIONAL :: & 
    1574          & cdunits     ! Units for variable 
    1575       CHARACTER(len=*), OPTIONAL :: & 
    1576          & cfillvalue  ! Fill value for character variables 
    1577       INTEGER, OPTIONAL :: & 
    1578          & ifillvalue  ! Fill value for integer variables 
    1579       REAL(kind=fbsp), OPTIONAL :: & 
    1580          & rfillvalue  ! Fill value for real variables 
    1581       CHARACTER(len=*), OPTIONAL :: & 
    1582          & conventions ! Conventions for variable 
     1536      INTEGER :: idfile                    ! File netcdf id. 
     1537      INTEGER :: idvar                     ! Variable netcdf id. 
     1538      CHARACTER(len=*) :: cdlongname       ! Long name for variable 
     1539      CHARACTER(len=*), OPTIONAL :: cdunits       ! Units for variable 
     1540      CHARACTER(len=*), OPTIONAL :: cfillvalue    ! Fill value for character variables 
     1541      INTEGER, OPTIONAL :: ifillvalue             ! Fill value for integer variables 
     1542      REAL(kind=fbsp), OPTIONAL :: rfillvalue     ! Fill value for real variables 
     1543      CHARACTER(len=*), OPTIONAL :: conventions   ! Conventions for variable 
    15831544      !! * Local variables 
    15841545      CHARACTER(LEN=18), PARAMETER :: & 
    … …  
    16431604      !!---------------------------------------------------------------------- 
    16441605      !! * Arguments 
    1645       CHARACTER(len=*) :: & 
    1646          & cdfilename ! Input filename 
    1647       TYPE(obfbdata)   :: & 
    1648          & fbdata     ! obsfbdata structure 
    1649       LOGICAL, OPTIONAL :: & 
    1650          & ldgrid     ! Allow forcing of grid info 
     1606      CHARACTER(len=*) :: cdfilename  ! Input filename 
     1607      TYPE(obfbdata)   :: fbdata      ! obsfbdata structure 
     1608      LOGICAL, OPTIONAL :: ldgrid     ! Allow forcing of grid info 
    16511609      !! * Local variables 
    16521610      CHARACTER(LEN=14), PARAMETER :: cpname = 'read_obfbdata' 
    1653       INTEGER :: & 
    1654          & idfile,  & 
    1655          & idodim,  & 
    1656          & idldim,  & 
    1657          & idvdim,  & 
    1658          & idadim,  & 
    1659          & idedim,  & 
    1660          & idgdim 
    1661       INTEGER :: & 
    1662          & idvard,  & 
    1663          & idaddd,  & 
    1664          & idextd,  & 
    1665          & idcdwmo, & 
    1666          & idcdtyp, & 
    1667          & idplam,  & 
    1668          & idpphi,  & 
    1669          & idpdep,  & 
    1670          & idptim,  & 
    1671          & idptimr, & 
    1672          & idioqc,  &          
    1673          & idioqcf, &          
    1674          & idipqc,  & 
    1675          & idipqcf, & 
    1676          & ididqc,  & 
    1677          & ididqcf, & 
    1678          & iditqc,  & 
    1679          & iditqcf, & 
    1680          & idkindex 
     1611      INTEGER :: idfile 
     1612      INTEGER :: idodim 
     1613      INTEGER :: idldim 
     1614      INTEGER :: idvdim 
     1615      INTEGER :: idadim 
     1616      INTEGER :: idedim 
     1617      INTEGER :: idgdim 
     1618      INTEGER :: idvard 
     1619      INTEGER :: idaddd 
     1620      INTEGER :: idextd 
     1621      INTEGER :: idcdwmo 
     1622      INTEGER :: idcdtyp 
     1623      INTEGER :: idplam 
     1624      INTEGER :: idpphi 
     1625      INTEGER :: idpdep 
     1626      INTEGER :: idptim 
     1627      INTEGER :: idptimr 
     1628      INTEGER :: idioqc         
     1629      INTEGER :: idioqcf 
     1630      INTEGER :: idipqc 
     1631      INTEGER :: idipqcf 
     1632      INTEGER :: ididqc 
     1633      INTEGER :: ididqcf 
     1634      INTEGER :: iditqc 
     1635      INTEGER :: iditqcf 
     1636      INTEGER :: idkindex 
    16811637      INTEGER, DIMENSION(:), ALLOCATABLE :: & 
    16821638         & idpob,    & 
    … …  
    16921648      INTEGER, DIMENSION(:,:), ALLOCATABLE :: & 
    16931649         & idpadd 
    1694       INTEGER :: & 
    1695          & jv, & 
    1696          & je 
    1697       INTEGER :: & 
    1698          & nvar, & 
    1699          & nobs, & 
    1700          & nlev, & 
    1701          & nadd, & 
    1702          & next 
    1703       LOGICAL :: & 
    1704          & lgrid 
    1705       CHARACTER(len=NF90_MAX_NAME) :: & 
    1706          & cdtmp 
     1650      INTEGER :: jv 
     1651      INTEGER :: je 
     1652      INTEGER :: nvar 
     1653      INTEGER :: nobs 
     1654      INTEGER :: nlev 
     1655      INTEGER :: nadd 
     1656      INTEGER :: next 
     1657      LOGICAL :: lgrid 
     1658      CHARACTER(len=NF90_MAX_NAME) :: cdtmp 
    17071659 
    17081660      ! Check allocation status and deallocate previous allocated structures 
    … …  
    18951847                     &                     fbdata%caddlong(je,jv), & 
    18961848                     &                     fbdata%caddunit(je,jv) ) 
    1897                ENDDO 
     1849               END DO 
    18981850            ENDIF 
    18991851             
    … …  
    19491901            ENDIF 
    19501902             
    1951          ENDDO 
     1903         END DO 
    19521904          
    19531905         IF ( fbdata%next > 0 ) THEN 
    … …  
    19621914                  &                     fbdata%cextlong(je), & 
    19631915                  &                     fbdata%cextunit(je) ) 
    1964             ENDDO 
     1916            END DO 
    19651917         ENDIF 
    19661918 
    19671919      ELSE ! if no observations only get attributes 
    19681920 
    1969          DO jv = 1, fbdata%nvar 
    1970              
     1921         DO jv = 1, fbdata%nvar             
     1922 
    19711923            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_OBS' 
    19721924            CALL chkerr( nf90_inq_varid( idfile, cdtmp, idpob(jv) ), & 
    … …  
    19851937                     &                     fbdata%caddlong(je,jv), & 
    19861938                     &                     fbdata%caddunit(je,jv) ) 
    1987                ENDDO 
    1988              
     1939               END DO 
    19891940            ENDIF 
    19901941             
    1991          ENDDO 
     1942         END DO 
    19921943          
    19931944         IF ( fbdata%next > 0 ) THEN 
    … …  
    19991950                  &                     fbdata%cextlong(je), & 
    20001951                  &                     fbdata%cextunit(je) ) 
    2001             ENDDO 
     1952            END DO 
    20021953         ENDIF 
    20031954 
    … …  
    20221973      !!---------------------------------------------------------------------- 
    20231974      !! * Arguments 
    2024       INTEGER :: & 
    2025          & idfile, &   ! File netcdf id. 
    2026          & idvar       ! Variable netcdf id. 
    2027       CHARACTER(len=*) :: & 
    2028          & cdlongname  ! Long name for variable 
    2029       CHARACTER(len=*) :: & 
    2030          & cdunits     ! Units for variable 
     1975      INTEGER :: idfile      ! File netcdf id. 
     1976      INTEGER :: idvar       ! Variable netcdf id. 
     1977      CHARACTER(len=*) :: cdlongname  ! Long name for variable 
     1978      CHARACTER(len=*) :: cdunits     ! Units for variable 
    20311979      !! * Local variables 
    2032       CHARACTER(LEN=18), PARAMETER :: & 
    2033          & cpname = 'getvaratt_obfbdata' 
     1980      CHARACTER(LEN=18), PARAMETER :: cpname = 'getvaratt_obfbdata' 
    20341981 
    20351982      CALL chkerr( nf90_get_att( idfile, idvar, 'long_name', & 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_grid.F90

    r2001 r2074  
    7878 
    7979   ! Switches 
    80    LOGICAL, PUBLIC :: & 
    81       & ln_grid_search_lookup  ! Use lookup table to speed up grid search 
    82    LOGICAL, PUBLIC :: & 
    83       & ln_grid_global         ! Use global distribution of observations 
     80   LOGICAL, PUBLIC :: ln_grid_search_lookup  ! Use lookup table to speed up grid search 
     81   LOGICAL, PUBLIC :: ln_grid_global         ! Use global distribution of observations 
    8482   CHARACTER(LEN=44), PUBLIC :: & 
    8583      & grid_search_file    ! file name head for grid search lookup  
    … …  
    179177 
    180178      !! * Arguments 
    181       INTEGER :: & 
    182          & kobs                     ! Size of the observation arrays 
     179      INTEGER :: kobs                     ! Size of the observation arrays 
    183180      REAL(KIND=wp), DIMENSION(kobs), INTENT(IN) :: & 
    184181         & plam, &                  ! Longitude of obsrvations  
    … …  
    192189      REAL(KIND=wp), DIMENSION(:), ALLOCATABLE :: & 
    193190         & zplam 
    194       REAL(wp) :: & 
    195          & zlammax, & 
    196          & zlam 
    197       INTEGER :: & 
    198          & ji,      & 
    199          & jj,      & 
    200          & jk,      & 
    201          & jo,      & 
    202          & isx,     & 
    203          & isy,     & 
    204          & jimin,   & 
    205          & jimax,   & 
    206          & jjmin,   & 
    207          & jjmax,   & 
    208          & jojimin, & 
    209          & jojimax, & 
    210          & jojjmin, & 
    211          & jojjmax, & 
    212          & ipx1,    & 
    213          & ipy1,    & 
    214          & ip,      & 
    215          & jp,      & 
    216          & ipx,     & 
    217          & ipy,     & 
    218          & ipmx,    &  
    219          & jlon,    & 
    220          & jlat,    & 
    221          & joffset, & 
    222          & jostride 
     191      REAL(wp) :: zlammax 
     192      REAL(wp) :: zlam 
     193      INTEGER :: ji 
     194      INTEGER :: jj 
     195      INTEGER :: jk 
     196      INTEGER :: jo 
     197      INTEGER :: isx 
     198      INTEGER :: isy 
     199      INTEGER :: jimin 
     200      INTEGER :: jimax 
     201      INTEGER :: jjmin 
     202      INTEGER :: jjmax 
     203      INTEGER :: jojimin 
     204      INTEGER :: jojimax 
     205      INTEGER :: jojjmin 
     206      INTEGER :: jojjmax 
     207      INTEGER :: ipx1 
     208      INTEGER :: ipy1 
     209      INTEGER :: ip 
     210      INTEGER :: jp 
     211      INTEGER :: ipx 
     212      INTEGER :: ipy 
     213      INTEGER :: ipmx 
     214      INTEGER :: jlon 
     215      INTEGER :: jlat 
     216      INTEGER :: joffset 
     217      INTEGER :: jostride 
    223218      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: & 
    224219         & zlamg, & 
    … …  
    234229         & zlamtm,  & 
    235230         & zphitm 
    236       LOGICAL :: & 
    237          & llfourflag 
    238       INTEGER :: & 
    239          & ifourflagcountt, & 
    240          & ifourflagcountf 
    241       INTEGER, DIMENSION(5) :: & 
    242          & ifourflagcountr 
     231      LOGICAL :: llfourflag 
     232      INTEGER :: ifourflagcountt 
     233      INTEGER :: ifourflagcountf 
     234      INTEGER, DIMENSION(5) :: ifourflagcountr 
    243235 
    244236      !----------------------------------------------------------------------- 
    … …  
    307299      DO jo = 1, kobs 
    308300         zplam(jo) = plam(jo) 
    309       ENDDO 
     301      END DO 
    310302      !----------------------------------------------------------------------- 
    311303      ! Set default values for output 
    … …  
    520512                              kobsj(jo) = jj + 1 
    521513                              EXIT gridloop 
    522                            END IF 
     514                           ENDIF 
    523515                        ENDIF 
    524516                     ENDIF 
    525                   ENDDO 
    526                ENDDO gridloop 
     517                  END DO 
     518               END DO gridloop 
    527519 
    528520               !--------------------------------------------------------------- 
    … …  
    655647         & cpname = 'obs_grid_setup' 
    656648      CHARACTER(LEN=40) :: cfname       
    657       INTEGER :: & 
    658          & ji,      & 
    659          & jj,      & 
    660          & jk,      & 
    661          & jo 
    662       INTEGER :: & 
    663          & idfile, idny, idnx, idxpos, idypos, idlat, idlon, fileexist 
     649      INTEGER :: ji 
     650      INTEGER :: jj 
     651      INTEGER :: jk 
     652      INTEGER :: jo 
     653      INTEGER :: idfile, idny, idnx, idxpos, idypos 
     654      INTEGER :: idlat, idlon, fileexist 
    664655      INTEGER, DIMENSION(2) :: incdim 
    665656      CHARACTER(LEN=20) :: datestr=" ",timestr=" " 
    … …  
    669660      REAL(wp) :: meanxdiff2, meanydiff2 
    670661      INTEGER :: numx1, numx2, numy1, numy2, df 
    671       INTEGER :: & 
    672         & jimin, jimax, jjmin, jjmax 
     662      INTEGER :: jimin, jimax, jjmin, jjmax 
    673663      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: & 
    674664         & lonsi,     & 
    … …  
    782772                  lons(ji,jj) = lonmin + (ji-1) * dlon 
    783773                  lats(ji,jj) = latmin + (jj-1) * dlat 
    784                ENDDO 
    785             ENDDO 
     774               END DO 
     775            END DO 
    786776             
    787777            ! if we are not reading the file we need to create it 
    … …  
    819809                  lonsi(ji,jj) = lonmin + (ji-1) * dlon 
    820810                  latsi(ji,jj) = latmin + (jj-1) * dlat 
    821                ENDDO 
    822             ENDDO 
     811               END DO 
     812            END DO 
    823813             
    824814            CALL obs_grid_search_bruteforce( jpi, jpj, jpiglo, jpjglo,  & 
    … …  
    842832                  EXIT minlon_xpos 
    843833               ENDIF 
    844             ENDDO minlon_xpos 
     834            END DO minlon_xpos 
    845835 
    846836            maxlon_xpos: DO ji= nlons, 1, -1 
    … …  
    849839                  EXIT maxlon_xpos 
    850840               ENDIF 
    851             ENDDO maxlon_xpos 
     841            END DO maxlon_xpos 
    852842 
    853843            minlat_xpos: DO jj= 1, nlats 
    … …  
    856846                  EXIT minlat_xpos 
    857847               ENDIF 
    858             ENDDO minlat_xpos 
     848            END DO minlat_xpos 
    859849 
    860850            maxlat_xpos: DO jj= nlats, 1, -1 
    … …  
    863853                  EXIT maxlat_xpos 
    864854               ENDIF 
    865             ENDDO maxlat_xpos 
     855            END DO maxlat_xpos 
    866856 
    867857            lonmin = lonsi(jimin,jjmin) 
    … …  
    937927                     ENDIF 
    938928                  ENDIF 
    939                ENDDO 
    940             ENDDO 
     929               END DO 
     930            END DO 
    941931 
    942932            IF (lwp) THEN 
    … …  
    10351025               histy1(ji+1) = histy1(ji+1) + histy1(ji) 
    10361026               histy2(ji+1) = histy2(ji+1) + histy2(ji) 
    1037             ENDDO 
     1027            END DO 
    10381028 
    10391029            fhistx1(:) = histx1(:) * 1.0 / numx1 
    … …  
    11541144               ! obs_grid_search_lookup 
    11551145                
    1156             END IF 
     1146            ENDIF 
    11571147 
    11581148         ENDIF 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_grid_search_bruteforce.h90

    r2001 r2074  
    2424 
    2525      !! * Arguments 
    26       INTEGER, INTENT(IN) :: & 
    27          & kpi,     &               ! Number of local longitudes 
    28          & kpj,     &               ! Number of local latitudes 
    29          & kpiglo,  &               ! Number of global longitudes 
    30          & kpjglo,  &               ! Number of global latitudes 
    31          & kldi,    &               ! Start of inner domain in i 
    32          & klei,    &               ! End of inner domain in i 
    33          & kldj,    &               ! Start of inner domain in j 
    34          & klej,    &               ! End of inner domain in j 
    35          & kmyproc, &               ! Processor number for MPP 
    36          & ktotproc                 ! Total number of processors 
     26      INTEGER, INTENT(IN) :: kpi                ! Number of local longitudes 
     27      INTEGER, INTENT(IN) :: kpj                ! Number of local latitudes 
     28      INTEGER, INTENT(IN) :: kpiglo             ! Number of global longitudes 
     29      INTEGER, INTENT(IN) :: kpjglo             ! Number of global latitudes 
     30      INTEGER, INTENT(IN) :: kldi               ! Start of inner domain in i 
     31      INTEGER, INTENT(IN) :: klei               ! End of inner domain in i 
     32      INTEGER, INTENT(IN) :: kldj               ! Start of inner domain in j 
     33      INTEGER, INTENT(IN) :: klej               ! End of inner domain in j 
     34      INTEGER, INTENT(IN) :: kmyproc            ! Processor number for MPP 
     35      INTEGER, INTENT(IN) :: ktotproc           ! Total number of processors 
    3736      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: & 
    3837         & pglam,   &               ! Grid point longitude 
    3938         & pgphi,   &               ! Grid point latitude 
    4039         & pmask                    ! Grid point mask 
    41       INTEGER,INTENT(IN) :: & 
    42          & kobs                     ! Size of the observation arrays 
     40      INTEGER,INTENT(IN) :: kobs                ! Size of the observation arrays 
    4341      REAL(KIND=wp), DIMENSION(kobs), INTENT(IN) :: & 
    4442         & plam, &                  ! Longitude of obsrvations  
    … …  
    5250      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    5351         & zplam, zpphi 
    54       REAL(wp) :: & 
    55          & zlammax, & 
    56          & zlam 
    57       INTEGER :: & 
    58          & ji,      & 
    59          & jj,      & 
    60          & jk,      & 
    61          & jo,      & 
    62          & jlon,    & 
    63          & jlat,    & 
    64          & joffset, & 
    65          & jostride 
     52      REAL(wp) :: zlammax 
     53      REAL(wp) :: zlam 
     54      INTEGER :: ji 
     55      INTEGER :: jj 
     56      INTEGER :: jk 
     57      INTEGER :: jo 
     58      INTEGER :: jlon 
     59      INTEGER :: jlat 
     60      INTEGER :: joffset 
     61      INTEGER :: jostride 
    6662      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: & 
    6763         & zlamg, & 
    … …  
    143139         zplam(jo) = plam(jo) 
    144140         zpphi(jo) = pphi(jo) 
    145       ENDDO 
     141      END DO 
    146142      !----------------------------------------------------------------------- 
    147143      ! Set default values for output 
    … …  
    233229                        kobsj(jo) = jj + 1 
    234230                        EXIT gridloop 
    235                      END IF 
     231                     ENDIF 
    236232                  ENDIF 
    237233               ENDIF 
    238             ENDDO 
    239          ENDDO gridloop 
     234            END DO 
     235         END DO gridloop 
    240236          
    241237         !--------------------------------------------------------------------- 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_inter_h2d.h90

    r2001 r2074  
    11811181            pmatou(ji,jj) = 0.0_wp 
    11821182            zmat(ji,jj) = pmatin(ji,jj) 
    1183          ENDDO 
     1183         END DO 
    11841184         pmatou(jj,jj) = 1.0_wp 
    1185       ENDDO 
     1185      END DO 
    11861186      CALL lu_decomp( zmat, kdim, kdim, indx, zd ) 
    11871187      DO jj = 1, kdim 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_inter_sup.F90

    r2001 r2074  
    4747      !!---------------------------------------------------------------------- 
    4848      !! * Arguments 
    49       INTEGER, INTENT(IN) :: & 
    50          & kptsi, &         ! Number of i horizontal points per stencil  
    51          & kptsj, &         ! Number of j horizontal points per stencil 
    52          & kobs, &          ! Local number of observations 
    53          & kpk              ! Number of levels 
     49      INTEGER, INTENT(IN) :: kptsi     ! Number of i horizontal points per stencil  
     50      INTEGER, INTENT(IN) :: kptsj     ! Number of j horizontal points per stencil 
     51      INTEGER, INTENT(IN) :: kobs      ! Local number of observations 
     52      INTEGER, INTENT(IN) :: kpk       ! Number of levels 
    5453      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    5554         & kgrdi, &         ! i,j indicies for each stencil 
    … …  
    101100      !!---------------------------------------------------------------------- 
    102101      !! * Arguments 
    103       INTEGER, INTENT(IN) :: & 
    104          & kptsi, &         ! Number of i horizontal points per stencil 
    105          & kptsj, &         ! Number of j horizontal points per stencil 
    106          & kobs             ! Local number of observations 
     102      INTEGER, INTENT(IN) :: kptsi        ! Number of i horizontal points per stencil 
     103      INTEGER, INTENT(IN) :: kptsj        ! Number of j horizontal points per stencil 
     104      INTEGER, INTENT(IN) :: kobs          ! Local number of observations 
    107105      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    108106         & kgrdi, &         ! i,j indicies for each stencil 
    … …  
    160158      !!---------------------------------------------------------------------- 
    161159      !! * Arguments 
    162       INTEGER, INTENT(IN) :: & 
    163          & kptsi, &         ! Number of i horizontal points per stencil  
    164          & kptsj, &         ! Number of j horizontal points per stencil 
    165          & kobs, &          ! Local number of observations 
    166          & kpk              ! Number of levels 
     160      INTEGER, INTENT(IN) :: kptsi     ! Number of i horizontal points per stencil  
     161      INTEGER, INTENT(IN) :: kptsj     ! Number of j horizontal points per stencil 
     162      INTEGER, INTENT(IN) :: kobs      ! Local number of observations 
     163      INTEGER, INTENT(IN) :: kpk       ! Number of levels 
    167164      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    168165         & kgrdi, &         ! i,j indicies for each stencil 
    … …  
    184181         & iorder, & 
    185182         & iproc 
    186       INTEGER :: & 
    187          & nplocal(jpnij), & 
    188          & npglobal(jpnij) 
    189       INTEGER :: & 
    190          & ji,    & 
    191          & jj,    & 
    192          & jk,    & 
    193          & jp,    & 
    194          & jobs,  & 
    195          & it,    & 
    196          & itot,  & 
    197          & ii,    & 
    198          & ij 
     183      INTEGER :: nplocal(jpnij) 
     184      INTEGER :: npglobal(jpnij) 
     185      INTEGER :: ji 
     186      INTEGER :: jj 
     187      INTEGER :: jk 
     188      INTEGER :: jp 
     189      INTEGER :: jobs 
     190      INTEGER :: it 
     191      INTEGER :: itot 
     192      INTEGER :: ii 
     193      INTEGER :: ij 
    199194 
    200195      ! Check valid points 
    … …  
    332327      !!---------------------------------------------------------------------- 
    333328      !! * Arguments 
    334       INTEGER, INTENT(IN) :: & 
    335          & kptsi, &         ! Number of i horizontal points per stencil  
    336          & kptsj, &         ! Number of j horizontal points per stencil 
    337          & kobs, &          ! Local number of observations 
    338          & kpk              ! Number of levels 
     329      INTEGER, INTENT(IN) :: kptsi        ! Number of i horizontal points per stencil  
     330      INTEGER, INTENT(IN) :: kptsj        ! Number of j horizontal points per stencil 
     331      INTEGER, INTENT(IN) :: kobs         ! Local number of observations 
     332      INTEGER, INTENT(IN) :: kpk          ! Number of levels 
    339333      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    340334         & kgrdi, &         ! i,j indicies for each stencil 
    … …  
    345339         & pgval            ! Stencil at each point 
    346340      !! * Local declarations 
    347       INTEGER :: & 
    348          & ji,    & 
    349          & jj,    & 
    350          & jk,    & 
    351          & jobs 
     341      INTEGER ::  ji 
     342      INTEGER ::  jj 
     343      INTEGER ::  jk 
     344      INTEGER ::  jobs 
    352345 
    353346      ! Check valid points 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_inter_z1d.h90

    r2001 r2074  
    2323 
    2424      !! * Arguments 
    25       INTEGER, INTENT(IN) :: & 
    26          & kpk,    &            ! Number of vertical levels 
    27          & k1dint, &            ! 0 = linear; 1 = cubic spline interpolation  
    28          & kdep                 ! Number of levels in profile 
     25      INTEGER, INTENT(IN) :: kpk        ! Number of vertical levels 
     26      INTEGER, INTENT(IN) :: k1dint     ! 0 = linear; 1 = cubic spline interpolation  
     27      INTEGER, INTENT(IN) :: kdep       ! Number of levels in profile 
    2928      INTEGER, INTENT(IN), DIMENSION(kdep) :: & 
    3029         & kkco                 ! Array indicies for interpolation 
    … …  
    4039   
    4140      !! * Local declarations 
    42       REAL(KIND=wp) :: & 
    43          & z1dm, &              ! Distance above and below obs to model grid points 
    44          & z1dp, &           
    45          & zsum, &              ! Dummy variables for computation 
    46          & zsum2             
    47       INTEGER :: & 
    48          jdep                   ! Observation depths loop variable 
     41      REAL(KIND=wp) :: z1dm       ! Distance above and below obs to model grid points 
     42      REAL(KIND=wp) :: z1dp          
     43      REAL(KIND=wp) :: zsum       ! Dummy variables for computation 
     44      REAL(KIND=wp) :: zsum2 
     45      INTEGER :: jdep             ! Observation depths loop variable 
    4946     
    5047      !------------------------------------------------------------------------ 
    … …  
    8582 
    8683         ENDIF 
    87       ENDDO 
     84      END DO 
    8885 
    8986   END SUBROUTINE obs_int_z1d 
    … …  
    114111      
    115112      !! * Arguments 
    116       INTEGER, INTENT(IN) :: & 
    117          & kpk               ! Number of vertical levels 
     113      INTEGER, INTENT(IN) :: kpk               ! Number of vertical levels 
    118114      REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: & 
    119115         & pobsk, &          ! Model profile at a given (lon,lat) 
    … …  
    124120   
    125121      !! * Local declarations 
    126       INTEGER :: & 
    127          & jk 
    128       REAL(KIND=wp) :: & 
    129          & za,   & 
    130          & zb,   & 
    131          & zc,   & 
    132          & zpa,  & 
    133          & zkm,  & 
    134          & zkp,  & 
    135          & zk 
     122      INTEGER :: jk 
     123      REAL(KIND=wp) :: za 
     124      REAL(KIND=wp) :: zb 
     125      REAL(KIND=wp) :: zc 
     126      REAL(KIND=wp) :: zpa 
     127      REAL(KIND=wp) :: zkm 
     128      REAL(KIND=wp) :: zkp 
     129      REAL(KIND=wp) :: zk 
    136130      REAL(KIND=wp), DIMENSION(kpk-1) :: & 
    137131         & zs, & 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_level_search.h90

    r2001 r2074  
    1818 
    1919      !! * Arguments 
    20       INTEGER, INTENT(IN) :: & 
    21          &   kgrd     ! Number of gridpoints 
     20      INTEGER, INTENT(IN) :: kgrd     ! Number of gridpoints 
    2221      REAL(KIND=wp), DIMENSION(kgrd), INTENT(INOUT) :: & 
    2322         &   pgrddep  ! Depths of gridpoints 
    … …  
    3029   
    3130      !! * Local declarations 
    32       INTEGER :: & 
    33          &   ji, & 
    34          &   jk 
     31      INTEGER :: ji 
     32      INTEGER :: jk 
    3533 
    3634      !------------------------------------------------------------------------ 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_mpp.F90

    r2001 r2074  
    6969 
    7070      !! * Arguments 
    71       INTEGER, INTENT(IN) :: & 
    72          & kno,  &       ! Number of elements in array 
    73          & kroot         ! Processor to send data 
     71      INTEGER, INTENT(IN) :: kno       ! Number of elements in array 
     72      INTEGER, INTENT(IN) :: kroot      ! Processor to send data 
    7473      INTEGER, DIMENSION(kno), INTENT(INOUT) :: & 
    7574         & kvals         ! Array to send on kroot, receive for non-kroot 
    … …  
    7776#if defined key_mpp_mpi 
    7877      !! * Local declarations 
    79       INTEGER :: & 
    80          & ierr 
     78      INTEGER :: ierr 
    8179#     include <mpif.h> 
    8280 
    … …  
    112110 
    113111      !! * Arguments 
    114       INTEGER, INTENT(IN) :: & 
    115          & kno       ! Number of elements in array 
     112      INTEGER, INTENT(IN) ::kno       ! Number of elements in array 
    116113      INTEGER, DIMENSION(kno), INTENT(INOUT) :: & 
    117114         & kvals     ! Array to send on kroot, receive for non-kroot   
    … …  
    119116#if defined key_mpp_mpi 
    120117      !! * Local declarations 
    121       INTEGER :: & 
    122          & ierr 
     118      INTEGER :: ierr 
    123119      INTEGER, DIMENSION(kno) :: & 
    124120         & ivals 
    … …  
    159155 
    160156      !! * Arguments 
    161       INTEGER, INTENT(IN) :: & 
    162          & kno 
     157      INTEGER, INTENT(IN) :: kno 
    163158      INTEGER, DIMENSION(kno), INTENT(IN) :: & 
    164159         & kobsi, & 
    … …  
    169164#if defined key_mpp_mpi 
    170165      !! * Local declarations 
    171       INTEGER :: & 
    172          & ji, & 
    173          & jj 
    174       INTEGER :: & 
    175          & size, & 
    176          & ierr, & 
    177          & iobsip, & 
    178          & iobsjp, & 
    179          & num_sus_obs 
     166      INTEGER :: ji 
     167      INTEGER :: jj 
     168      INTEGER :: size 
     169      INTEGER :: ierr 
     170      INTEGER :: iobsip 
     171      INTEGER :: iobsjp 
     172      INTEGER :: num_sus_obs 
    180173      INTEGER, DIMENSION(kno) :: & 
    181174         & iobsig, & 
    … …  
    283276 
    284277      !! * Arguments 
    285       INTEGER, INTENT(IN) :: & 
    286          & kno 
     278      INTEGER, INTENT(IN) :: kno 
    287279      INTEGER, DIMENSION(kno), INTENT(IN) :: & 
    288280         & kvalsin 
    … …  
    292284#if defined key_mpp_mpi 
    293285      !! * Local declarations 
    294       INTEGER :: & 
    295          & ierr 
     286      INTEGER :: ierr 
    296287#     include <mpif.h> 
    297288  
    … …  
    331322 
    332323      !! * Arguments 
    333       INTEGER, INTENT(IN) :: & 
    334          & kvalin 
    335       INTEGER, INTENT(OUT) :: & 
    336          & kvalout 
    337  
    338 #if defined key_mpp_mpi 
    339       !! * Local declarations 
    340       INTEGER :: & 
    341          & ierr 
     324      INTEGER, INTENT(IN) :: kvalin 
     325      INTEGER, INTENT(OUT) :: kvalout 
     326 
     327#if defined key_mpp_mpi 
     328      !! * Local declarations 
     329      INTEGER :: ierr 
    342330#     include <mpif.h> 
    343331 
    … …  
    380368         & pval 
    381369      !! * Local declarations 
    382       INTEGER :: & 
    383          & ierr 
     370      INTEGER :: ierr 
    384371#if defined key_mpp_mpi 
    385372#include <mpif.h> 
    … …  
    427414 
    428415      !! * Arguments 
    429       INTEGER, INTENT(IN) :: & 
    430          & kno 
     416      INTEGER, INTENT(IN) :: kno 
    431417      INTEGER, DIMENSION(kno*jpnij), INTENT(IN) :: & 
    432418         & kvalsin 
    … …  
    434420         & kvalsout 
    435421      !! * Local declarations 
    436       INTEGER :: & 
    437          & ierr 
     422      INTEGER :: ierr 
    438423#if defined key_mpp_mpi 
    439424#include <mpif.h> 
    … …  
    474459 
    475460      !! * Arguments 
    476       INTEGER, INTENT(IN) :: & 
    477          & knoin, & 
    478          & knoout 
     461      INTEGER, INTENT(IN) :: knoin 
     462      INTEGER, INTENT(IN) :: knoout 
    479463      INTEGER, DIMENSION(jpnij) :: & 
    480464         & kinv, & 
    … …  
    485469         & kvalsout 
    486470      !! * Local declarations 
    487       INTEGER :: & 
    488          & ierr, & 
    489          & jproc 
     471      INTEGER :: ierr 
     472      INTEGER :: jproc 
    490473#if defined key_mpp_mpi 
    491474#include <mpif.h> 
    … …  
    501484         isdsp(jproc) = isdsp(jproc-1) + kinv(jproc-1) 
    502485         irdsp(jproc) = irdsp(jproc-1) + koutv(jproc-1) 
    503       ENDDO 
     486      END DO 
    504487      !----------------------------------------------------------------------- 
    505488      ! Call the MPI library to do the all to all operation of the data 
    … …  
    538521 
    539522      !! * Arguments 
    540       INTEGER, INTENT(IN) :: & 
    541          & knoin, & 
    542          & knoout 
     523      INTEGER, INTENT(IN) :: knoin 
     524      INTEGER, INTENT(IN) :: knoout 
    543525      INTEGER, DIMENSION(jpnij) :: & 
    544526         & kinv, & 
    … …  
    549531         & pvalsout 
    550532      !! * Local declarations 
    551       INTEGER :: & 
    552          & ierr, & 
    553          & jproc 
     533      INTEGER :: ierr 
     534      INTEGER :: jproc 
    554535#if defined key_mpp_mpi 
    555536#include <mpif.h> 
    … …  
    565546         isdsp(jproc) = isdsp(jproc-1) + kinv(jproc-1) 
    566547         irdsp(jproc) = irdsp(jproc-1) + koutv(jproc-1) 
    567       ENDDO 
     548      END DO 
    568549      !----------------------------------------------------------------------- 
    569550      ! Call the MPI library to do the all to all operation of the data 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_oper.F90

    r2001 r2074  
    115115 
    116116      !! * Arguments 
    117       TYPE(obs_prof), INTENT(INOUT) :: & 
    118          & prodatqc        ! Subset of profile data not failing screening 
    119       INTEGER, INTENT(IN) :: & 
    120          & kt,     &    ! Time step 
    121          & kpi,    &    ! Model grid parameters 
    122          & kpj,    & 
    123          & kpk,    &  
    124          & kit000, &    ! Number of the first time step  
    125                         !   (kit000-1 = restart time) 
    126          & k1dint, &    ! Vertical interpolation type (see header) 
    127          & k2dint, &    ! Horizontal interpolation type (see header) 
    128          & kdaystp      ! Number of time steps per day                     
     117      TYPE(obs_prof), INTENT(INOUT) :: prodatqc  ! Subset of profile data not failing screening 
     118      INTEGER, INTENT(IN) :: kt        ! Time step 
     119      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters 
     120      INTEGER, INTENT(IN) :: kpj 
     121      INTEGER, INTENT(IN) :: kpk 
     122      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step  
     123                                       !   (kit000-1 = restart time) 
     124      INTEGER, INTENT(IN) :: k1dint    ! Vertical interpolation type (see header) 
     125      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header) 
     126      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                     
    129127      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 
    130128         & ptn,    &    ! Model temperature field 
    … …  
    136134         & kdailyavtypes! Types for daily averages 
    137135      !! * Local declarations 
    138       INTEGER ::   & 
    139          & ji,     & 
    140          & jj,     & 
    141          & jk,     & 
    142          & jobs,   & 
    143          & inrc,   & 
    144          & ipro,   & 
    145          & idayend,& 
    146          & ista,   & 
    147          & iend,   & 
    148          & iobs 
     136      INTEGER ::   ji 
     137      INTEGER ::   jj 
     138      INTEGER ::   jk 
     139      INTEGER ::   jobs 
     140      INTEGER ::   inrc 
     141      INTEGER ::   ipro 
     142      INTEGER ::   idayend 
     143      INTEGER ::   ista 
     144      INTEGER ::   iend 
     145      INTEGER ::   iobs 
    149146      INTEGER, DIMENSION(imaxavtypes) :: & 
    150147         & idailyavtypes 
    151       REAL(KIND=wp) :: & 
    152          & zlam,   & 
    153          & zphi,   & 
    154          & zdaystp 
     148      REAL(KIND=wp) :: zlam 
     149      REAL(KIND=wp) :: zphi 
     150      REAL(KIND=wp) :: zdaystp 
    155151      REAL(KIND=wp), DIMENSION(kpk) :: & 
    156152         & zobsmask, & 
    … …  
    421417         ENDIF 
    422418 
    423       ENDDO 
     419      END DO 
    424420  
    425421      ! Deallocate the data for interpolation 
    … …  
    482478 
    483479      !! * Arguments 
    484       TYPE(obs_surf), INTENT(INOUT) :: & 
    485          & sladatqc     ! Subset of surface data not failing screening 
    486       INTEGER, INTENT(IN) :: & 
    487          & kt,     &    ! Time step 
    488          & kpi,    &    ! Model grid parameters 
    489          & kpj,    & 
    490          & kit000, &    ! Number of the first time step  
    491                         !   (kit000-1 = restart time) 
    492          & k2dint       ! Horizontal interpolation type (see header) 
     480      TYPE(obs_surf), INTENT(INOUT) :: sladatqc     ! Subset of surface data not failing screening 
     481      INTEGER, INTENT(IN) :: kt      ! Time step 
     482      INTEGER, INTENT(IN) :: kpi     ! Model grid parameters 
     483      INTEGER, INTENT(IN) :: kpj 
     484      INTEGER, INTENT(IN) :: kit000   ! Number of the first time step  
     485                                      !   (kit000-1 = restart time) 
     486      INTEGER, INTENT(IN) :: k2dint   ! Horizontal interpolation type (see header) 
    493487      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
    494488         & psshn,  &    ! Model SSH field 
    … …  
    496490          
    497491      !! * Local declarations 
    498       INTEGER ::   & 
    499          & ji,     & 
    500          & jj,     & 
    501          & jobs,   & 
    502          & inrc,   & 
    503          & isla,   & 
    504          & iobs 
    505       REAL(KIND=wp) :: & 
    506          & zlam,   & 
    507          & zphi 
     492      INTEGER :: ji 
     493      INTEGER :: jj 
     494      INTEGER :: jobs 
     495      INTEGER :: inrc 
     496      INTEGER :: isla 
     497      INTEGER :: iobs 
     498      REAL(KIND=wp) :: zlam 
     499      REAL(KIND=wp) :: zphi 
    508500      REAL(KIND=wp) :: zext(1), zobsmask(1) 
    509501      REAL(kind=wp), DIMENSION(2,2,1) :: & 
    … …  
    524516      inrc = kt - kit000 + 2 
    525517      isla = sladatqc%nsstp(inrc) 
    526     
     518 
    527519      ! Get the data for interpolation 
    528520 
    … …  
    653645      TYPE(obs_surf), INTENT(INOUT) :: & 
    654646         & sstdatqc     ! Subset of surface data not failing screening 
    655       INTEGER, INTENT(IN) :: & 
    656          & kt,     &    ! Time step 
    657          & kpi,    &    ! Model grid parameters 
    658          & kpj,    & 
    659          & kit000, &    ! Number of the first time step  
    660                         !   (kit000-1 = restart time) 
    661          & k2dint       ! Horizontal interpolation type (see header) 
     647      INTEGER, INTENT(IN) :: kt        ! Time step 
     648      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters 
     649      INTEGER, INTENT(IN) :: kpj 
     650      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step  
     651                                       !   (kit000-1 = restart time) 
     652      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header) 
    662653      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
    663654         & psstn,  &    ! Model SST field 
    … …  
    665656          
    666657      !! * Local declarations 
    667       INTEGER ::   & 
    668          & ji,     & 
    669          & jj,     & 
    670          & jobs,   & 
    671          & inrc,   & 
    672          & isst,   & 
    673          & iobs 
    674       REAL(KIND=wp) :: & 
    675          & zlam,   & 
    676          & zphi 
     658      INTEGER :: ji 
     659      INTEGER :: jj 
     660      INTEGER :: jobs 
     661      INTEGER :: inrc 
     662      INTEGER :: isst 
     663      INTEGER :: iobs 
     664      REAL(KIND=wp) :: zlam 
     665      REAL(KIND=wp) :: zphi 
    677666      REAL(KIND=wp) :: zext(1), zobsmask(1) 
    678667      REAL(kind=wp), DIMENSION(2,2,1) :: & 
    … …  
    838827 
    839828      !! * Arguments 
    840       TYPE(obs_surf), INTENT(INOUT) :: & 
    841          & seaicedatqc     ! Subset of surface data not failing screening 
    842       INTEGER, INTENT(IN) :: & 
    843          & kt,     &    ! Time step 
    844          & kpi,    &    ! Model grid parameters 
    845          & kpj,    & 
    846          & kit000, &    ! Number of the first time step  
    847                         !   (kit000-1 = restart time) 
    848          & k2dint       ! Horizontal interpolation type (see header) 
     829      TYPE(obs_surf), INTENT(INOUT) :: seaicedatqc     ! Subset of surface data not failing screening 
     830      INTEGER, INTENT(IN) :: kt       ! Time step 
     831      INTEGER, INTENT(IN) :: kpi      ! Model grid parameters 
     832      INTEGER, INTENT(IN) :: kpj 
     833      INTEGER, INTENT(IN) :: kit000   ! Number of the first time step  
     834                                      !   (kit000-1 = restart time) 
     835      INTEGER, INTENT(IN) :: k2dint   ! Horizontal interpolation type (see header) 
    849836      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
    850837         & pseaicen,  &    ! Model sea ice field 
    … …  
    852839          
    853840      !! * Local declarations 
    854       INTEGER ::   & 
    855          & ji,     & 
    856          & jj,     & 
    857          & jobs,   & 
    858          & inrc,   & 
    859          & iseaice,& 
    860          & iobs 
     841      INTEGER :: ji 
     842      INTEGER :: jj 
     843      INTEGER :: jobs 
     844      INTEGER :: inrc 
     845      INTEGER :: iseaice 
     846      INTEGER :: iobs 
    861847        
    862       REAL(KIND=wp) :: & 
    863          & zlam,   & 
    864          & zphi 
     848      REAL(KIND=wp) :: zlam 
     849      REAL(KIND=wp) :: zphi 
    865850      REAL(KIND=wp) :: zext(1), zobsmask(1) 
    866851      REAL(kind=wp), DIMENSION(2,2,1) :: & 
    … …  
    1001986      TYPE(obs_prof), INTENT(INOUT) :: & 
    1002987         & prodatqc        ! Subset of profile data not failing screening 
    1003       INTEGER, INTENT(IN) :: & 
    1004          & kt,     &    ! Time step 
    1005          & kpi,    &    ! Model grid parameters 
    1006          & kpj,    & 
    1007          & kpk,    &  
    1008          & kit000, &    ! Number of the first time step  
    1009                         !   (kit000-1 = restart time) 
    1010          & k1dint, &    ! Vertical interpolation type (see header) 
    1011          & k2dint, &    ! Horizontal interpolation type (see header) 
    1012          & kdaystp      ! Number of time steps per day                     
     988      INTEGER, INTENT(IN) :: kt        ! Time step 
     989      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters 
     990      INTEGER, INTENT(IN) :: kpj 
     991      INTEGER, INTENT(IN) :: kpk  
     992      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step  
     993                                       !   (kit000-1 = restart time) 
     994      INTEGER, INTENT(IN) :: k1dint    ! Vertical interpolation type (see header) 
     995      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header) 
     996      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                     
    1013997      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 
    1014998         & pun,    &    ! Model zonal component of velocity 
    … …  
    10181002      REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: & 
    10191003         & pgdept       ! Model array of depth levels 
    1020       LOGICAL, INTENT(IN) :: & 
    1021          & ld_dailyav 
     1004      LOGICAL, INTENT(IN) :: ld_dailyav 
    10221005          
    10231006      !! * Local declarations 
    1024       INTEGER ::   & 
    1025          & ji,     & 
    1026          & jj,     & 
    1027          & jk,     & 
    1028          & jobs,   & 
    1029          & inrc,   & 
    1030          & ipro,   & 
    1031          & idayend,& 
    1032          & ista,   & 
    1033          & iend,   & 
    1034          & iobs 
     1007      INTEGER :: ji 
     1008      INTEGER :: jj 
     1009      INTEGER :: jk 
     1010      INTEGER :: jobs 
     1011      INTEGER :: inrc 
     1012      INTEGER :: ipro 
     1013      INTEGER :: idayend 
     1014      INTEGER :: ista 
     1015      INTEGER :: iend 
     1016      INTEGER :: iobs 
    10351017      INTEGER, DIMENSION(imaxavtypes) :: & 
    10361018         & idailyavtypes 
    1037       REAL(KIND=wp) :: & 
    1038          & zlam,   & 
    1039          & zphi,   & 
    1040          & zdaystp 
     1019      REAL(KIND=wp) :: zlam 
     1020      REAL(KIND=wp) :: zphi 
     1021      REAL(KIND=wp) :: zdaystp 
    10411022      REAL(KIND=wp), DIMENSION(kpk) :: & 
    10421023         & zobsmask, & 
    … …  
    13051286         ENDIF 
    13061287 
    1307       ENDDO 
     1288      END DO 
    13081289  
    13091290      ! Deallocate the data for interpolation 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_prep.F90

    r2001 r2074  
    7171         & nproc 
    7272      !! * Arguments 
    73       TYPE(obs_prof), INTENT(INOUT) :: & 
    74          & profdata,&         ! Full set of profile data 
    75          & prodatqc           ! Subset of profile data not failing screening 
    76       LOGICAL, INTENT(IN) :: & 
    77          & ld_t3d, &          ! Switch for temperature 
    78          & ld_s3d, &          ! Switch for salinity 
    79          & ld_nea             ! Switch for rejecting observation near land 
     73      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Full set of profile data 
     74      TYPE(obs_prof), INTENT(INOUT) :: prodatqc     ! Subset of profile data not failing screening 
     75      LOGICAL, INTENT(IN) :: ld_t3d         ! Switch for temperature 
     76      LOGICAL, INTENT(IN) :: ld_s3d         ! Switch for salinity 
     77      LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land 
    8078      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    8179         & kdailyavtypes! Types for daily averages 
    82       !! * Local declarations 
    83       INTEGER ::         &     
    84          & iyea0,        &    ! Initial date 
    85          & imon0,        &    !  - (year, month, day, hour, minute) 
    86          & iday0,        &     
    87          & ihou0,        &     
    88          & imin0 
    89       INTEGER ::         & 
    90          & icycle,       &    ! Current assimilation cycle 
    91                               ! Counters for observations that 
    92          & iotdobs,      &    !  - outside time domain 
    93          & iosdtobs,     &    !  - outside space domain (temperature) 
    94          & iosdsobs,     &    !  - outside space domain (salinity) 
    95          & ilantobs,     &    !  - within a model land cell (temperature) 
    96          & ilansobs,     &    !  - within a model land cell (salinity) 
    97          & inlatobs,     &    !  - close to land (temperature) 
    98          & inlasobs,     &    !  - close to land (salinity) 
    99          & igrdobs,      &    !  - fail the grid search 
    100                               ! Global counters for observations that 
    101          & iotdobsmpp,   &    !  - outside time domain 
    102          & iosdtobsmpp,  &    !  - outside space domain (temperature) 
    103          & iosdsobsmpp,  &    !  - outside space domain (salinity) 
    104          & ilantobsmpp,  &    !  - within a model land cell (temperature) 
    105          & ilansobsmpp,  &    !  - within a model land cell (salinity) 
    106          & inlatobsmpp,  &    !  - close to land (temperature) 
    107          & inlasobsmpp,  &    !  - close to land (salinity) 
    108          & igrdobsmpp         !  - fail the grid search 
    109       TYPE(obs_prof_valid) :: & 
    110          & llvalid            ! Profile selection  
     80      !! * Local declarations    
     81      INTEGER :: iyea0         ! Initial date 
     82      INTEGER :: imon0         !  - (year, month, day, hour, minute) 
     83      INTEGER :: iday0    
     84      INTEGER :: ihou0 
     85      INTEGER :: imin0 
     86      INTEGER :: icycle        ! Current assimilation cycle 
     87                               ! Counters for observations that 
     88      INTEGER :: iotdobs       !  - outside time domain 
     89      INTEGER :: iosdtobs      !  - outside space domain (temperature) 
     90      INTEGER :: iosdsobs      !  - outside space domain (salinity) 
     91      INTEGER :: ilantobs      !  - within a model land cell (temperature) 
     92      INTEGER :: ilansobs      !  - within a model land cell (salinity) 
     93      INTEGER :: inlatobs      !  - close to land (temperature) 
     94      INTEGER :: inlasobs      !  - close to land (salinity) 
     95      INTEGER :: igrdobs       !  - fail the grid search 
     96                               ! Global counters for observations that 
     97      INTEGER :: iotdobsmpp    !  - outside time domain 
     98      INTEGER :: iosdtobsmpp   !  - outside space domain (temperature) 
     99      INTEGER :: iosdsobsmpp   !  - outside space domain (salinity) 
     100      INTEGER :: ilantobsmpp   !  - within a model land cell (temperature) 
     101      INTEGER :: ilansobsmpp   !  - within a model land cell (salinity) 
     102      INTEGER :: inlatobsmpp   !  - close to land (temperature) 
     103      INTEGER :: inlasobsmpp   !  - close to land (salinity) 
     104      INTEGER :: igrdobsmpp    !  - fail the grid search 
     105      TYPE(obs_prof_valid) ::  llvalid     ! Profile selection  
    111106      TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: & 
    112          & llvvalid           ! T,S selection  
    113       INTEGER :: &             
    114          & jvar,         &    ! Variable loop variable 
    115          & jobs,         &    ! Obs. loop variable 
    116          & jstp,         &    ! Time loop variable 
    117          & inrc               ! Time index variable 
     107         & llvvalid            ! T,S selection  
     108      INTEGER :: jvar          ! Variable loop variable 
     109      INTEGER :: jobs          ! Obs. loop variable 
     110      INTEGER :: jstp          ! Time loop variable 
     111      INTEGER :: inrc          ! Time index variable 
    118112       
    119113      IF(lwp) WRITE(numout,*)'obs_pre_pro : Preparing the profile observations...' 
    … …  
    308302                  &                        prodatqc%npvsta(jobs,jvar) + 1 ) 
    309303            ENDIF 
    310          ENDDO 
    311       ENDDO 
     304         END DO 
     305      END DO 
    312306       
    313307       
    … …  
    318312            &                       prodatqc%nvstpmpp(:,jvar), & 
    319313            &                       nitend - nit000 + 2 ) 
    320       ENDDO 
     314      END DO 
    321315 
    322316      IF ( lwp ) THEN 
    … …  
    360354         & nproc 
    361355      !! * Arguments 
    362       TYPE(obs_surf), INTENT(INOUT) :: & 
    363          & sladata, &         ! Full set of SLA data 
    364          & sladatqc           ! Subset of SLA data not failing screening 
    365       LOGICAL, INTENT(IN) :: & 
    366          & ld_sla, &          ! Switch for SLA data 
    367          & ld_nea             ! Switch for rejecting observation near land 
     356      TYPE(obs_surf), INTENT(INOUT) :: sladata    ! Full set of SLA data 
     357      TYPE(obs_surf), INTENT(INOUT) :: sladatqc   ! Subset of SLA data not failing screening 
     358      LOGICAL, INTENT(IN) :: ld_sla         ! Switch for SLA data 
     359      LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land 
    368360      !! * Local declarations 
    369       INTEGER ::         &     
    370          & iyea0,        &    ! Initial date 
    371          & imon0,        &    !  - (year, month, day, hour, minute) 
    372          & iday0,        &     
    373          & ihou0,        &     
    374          & imin0 
    375       INTEGER ::         & 
    376          & icycle,       &    ! Current assimilation cycle 
     361      INTEGER :: iyea0        ! Initial date 
     362      INTEGER :: imon0        !  - (year, month, day, hour, minute) 
     363      INTEGER :: iday0     
     364      INTEGER :: ihou0     
     365      INTEGER :: imin0 
     366      INTEGER :: icycle       ! Current assimilation cycle 
    377367                              ! Counters for observations that 
    378          & iotdobs,      &    !  - outside time domain 
    379          & iosdsobs,     &    !  - outside space domain 
    380          & ilansobs,     &    !  - within a model land cell 
    381          & inlasobs,     &    !  - close to land 
    382          & igrdobs,      &    !  - fail the grid search 
     368      INTEGER :: iotdobs      !  - outside time domain 
     369      INTEGER :: iosdsobs     !  - outside space domain 
     370      INTEGER :: ilansobs     !  - within a model land cell 
     371      INTEGER :: inlasobs     !  - close to land 
     372      INTEGER :: igrdobs      !  - fail the grid search 
    383373                              ! Global counters for observations that 
    384          & iotdobsmpp,   &    !  - outside time domain 
    385          & iosdsobsmpp,  &    !  - outside space domain 
    386          & ilansobsmpp,  &    !  - within a model land cell 
    387          & inlasobsmpp,  &    !  - close to land 
    388          & igrdobsmpp         !  - fail the grid search 
     374      INTEGER :: iotdobsmpp     !  - outside time domain 
     375      INTEGER :: iosdsobsmpp    !  - outside space domain 
     376      INTEGER :: ilansobsmpp    !  - within a model land cell 
     377      INTEGER :: inlasobsmpp    !  - close to land 
     378      INTEGER :: igrdobsmpp     !  - fail the grid search 
    389379      LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    390380         & llvalid            ! SLA data selection 
    391       INTEGER :: &             
    392          & jobs,         &    ! Obs. loop variable 
    393          & jstp,         &    ! Time loop variable 
    394          & inrc               ! Time index variable 
     381      INTEGER :: jobs         ! Obs. loop variable 
     382      INTEGER :: jstp         ! Time loop variable 
     383      INTEGER :: inrc         ! Time index variable 
    395384 
    396385      IF(lwp) WRITE(numout,*)'obs_pre_sla : Preparing the SLA observations...' 
    … …  
    5265151998  FORMAT(10X,'---------',5X,'-----------------') 
    5275161999  FORMAT(10X,I9,5X,I17) 
    528        
     517 
    529518   END SUBROUTINE obs_pre_sla 
    530519 
    … …  
    553542         & nproc 
    554543      !! * Arguments 
    555       TYPE(obs_surf), INTENT(INOUT) :: & 
    556          & sstdata, &         ! Full set of SST data 
    557          & sstdatqc           ! Subset of SST data not failing screening 
    558       LOGICAL :: & 
    559          & ld_sst, &          ! Switch for SST data 
    560          & ld_nea             ! Switch for rejecting observation near land 
     544      TYPE(obs_surf), INTENT(INOUT) :: sstdata     ! Full set of SST data 
     545      TYPE(obs_surf), INTENT(INOUT) :: sstdatqc    ! Subset of SST data not failing screening 
     546      LOGICAL :: ld_sst             ! Switch for SST data 
     547      LOGICAL :: ld_nea             ! Switch for rejecting observation near land 
    561548      !! * Local declarations 
    562       INTEGER ::         &     
    563          & iyea0,        &    ! Initial date 
    564          & imon0,        &    !  - (year, month, day, hour, minute) 
    565          & iday0,        &     
    566          & ihou0,        &     
    567          & imin0 
    568       INTEGER ::         & 
    569          & icycle,       &    ! Current assimilation cycle 
     549      INTEGER :: iyea0        ! Initial date 
     550      INTEGER :: imon0        !  - (year, month, day, hour, minute) 
     551      INTEGER :: iday0    
     552      INTEGER :: ihou0     
     553      INTEGER :: imin0 
     554      INTEGER :: icycle       ! Current assimilation cycle 
    570555                              ! Counters for observations that 
    571          & iotdobs,      &    !  - outside time domain 
    572          & iosdsobs,     &    !  - outside space domain 
    573          & ilansobs,     &    !  - within a model land cell 
    574          & inlasobs,     &    !  - close to land 
    575          & igrdobs,      &    !  - fail the grid search 
     556      INTEGER :: iotdobs      !  - outside time domain 
     557      INTEGER :: iosdsobs     !  - outside space domain 
     558      INTEGER :: ilansobs     !  - within a model land cell 
     559      INTEGER :: inlasobs     !  - close to land 
     560      INTEGER :: igrdobs      !  - fail the grid search 
    576561                              ! Global counters for observations that 
    577          & iotdobsmpp,   &    !  - outside time domain 
    578          & iosdsobsmpp,  &    !  - outside space domain 
    579          & ilansobsmpp,  &    !  - within a model land cell 
    580          & inlasobsmpp,  &    !  - close to land 
    581          & igrdobsmpp         !  - fail the grid search 
     562      INTEGER :: iotdobsmpp   !  - outside time domain 
     563      INTEGER :: iosdsobsmpp  !  - outside space domain 
     564      INTEGER :: ilansobsmpp  !  - within a model land cell 
     565      INTEGER :: inlasobsmpp  !  - close to land 
     566      INTEGER :: igrdobsmpp   !  - fail the grid search 
    582567      LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    583568         & llvalid            ! SST data selection 
    584       INTEGER :: &             
    585          & jobs,         &    ! Obs. loop variable 
    586          & jstp,         &    ! Time loop variable 
    587          & inrc               ! Time index variable 
     569      INTEGER :: jobs         ! Obs. loop variable 
     570      INTEGER :: jstp         ! Time loop variable 
     571      INTEGER :: inrc         ! Time index variable 
    588572 
    589573      IF(lwp) WRITE(numout,*)'obs_pre_sst : Preparing the SST observations...' 
    … …  
    743727         & nproc 
    744728      !! * Arguments 
    745       TYPE(obs_surf), INTENT(INOUT) :: & 
    746          & seaicedata, &         ! Full set of Sea Ice data 
    747          & seaicedatqc           ! Subset of sea ice data not failing screening 
    748       LOGICAL :: & 
    749          & ld_seaice, &          ! Switch for sea ice data 
    750          & ld_nea                ! Switch for rejecting observation near land 
     729      TYPE(obs_surf), INTENT(INOUT) :: seaicedata     ! Full set of Sea Ice data 
     730      TYPE(obs_surf), INTENT(INOUT) :: seaicedatqc    ! Subset of sea ice data not failing screening 
     731      LOGICAL :: ld_seaice     ! Switch for sea ice data 
     732      LOGICAL :: ld_nea        ! Switch for rejecting observation near land 
    751733      !! * Local declarations 
    752       INTEGER ::         &     
    753          & iyea0,        &    ! Initial date 
    754          & imon0,        &    !  - (year, month, day, hour, minute) 
    755          & iday0,        &     
    756          & ihou0,        &     
    757          & imin0 
    758       INTEGER ::         & 
    759          & icycle,       &    ! Current assimilation cycle 
     734      INTEGER :: iyea0         ! Initial date 
     735      INTEGER :: imon0         !  - (year, month, day, hour, minute) 
     736      INTEGER :: iday0     
     737      INTEGER :: ihou0     
     738      INTEGER :: imin0 
     739      INTEGER :: icycle       ! Current assimilation cycle 
    760740                              ! Counters for observations that 
    761          & iotdobs,      &    !  - outside time domain 
    762          & iosdsobs,     &    !  - outside space domain 
    763          & ilansobs,     &    !  - within a model land cell 
    764          & inlasobs,     &    !  - close to land 
    765          & igrdobs,      &    !  - fail the grid search 
     741      INTEGER :: iotdobs      !  - outside time domain 
     742      INTEGER :: iosdsobs     !  - outside space domain 
     743      INTEGER :: ilansobs     !  - within a model land cell 
     744      INTEGER :: inlasobs     !  - close to land 
     745      INTEGER :: igrdobs      !  - fail the grid search 
    766746                              ! Global counters for observations that 
    767          & iotdobsmpp,   &    !  - outside time domain 
    768          & iosdsobsmpp,  &    !  - outside space domain 
    769          & ilansobsmpp,  &    !  - within a model land cell 
    770          & inlasobsmpp,  &    !  - close to land 
    771          & igrdobsmpp         !  - fail the grid search 
     747      INTEGER :: iotdobsmpp   !  - outside time domain 
     748      INTEGER :: iosdsobsmpp  !  - outside space domain 
     749      INTEGER :: ilansobsmpp  !  - within a model land cell 
     750      INTEGER :: inlasobsmpp  !  - close to land 
     751      INTEGER :: igrdobsmpp   !  - fail the grid search 
    772752      LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    773          & llvalid            ! sea ice data selection 
    774       INTEGER :: &             
    775          & jobs,         &    ! Obs. loop variable 
    776          & jstp,         &    ! Time loop variable 
    777          & inrc               ! Time index variable 
     753         & llvalid            ! data selection 
     754      INTEGER :: jobs         ! Obs. loop variable 
     755      INTEGER :: jstp         ! Time loop variable 
     756      INTEGER :: inrc         ! Time index variable 
    778757 
    779758      IF (lwp) WRITE(numout,*)'obs_pre_seaice : Preparing the sea ice observations...' 
    … …  
    933912         & nproc 
    934913      !! * Arguments 
    935       TYPE(obs_prof), INTENT(INOUT) :: & 
    936          & profdata,&         ! Full set of profile data 
    937          & prodatqc           ! Subset of profile data not failing screening 
    938       LOGICAL, INTENT(IN) :: & 
    939          & ld_vel3d, &        ! Switch for zonal and meridional velocity components 
    940          & ld_nea, &          ! Switch for rejecting observation near land 
    941          & ld_dailyav         ! Switch for daily average data 
     914      TYPE(obs_prof), INTENT(INOUT) :: profdata   ! Full set of profile data 
     915      TYPE(obs_prof), INTENT(INOUT) :: prodatqc   ! Subset of profile data not failing screening 
     916      LOGICAL, INTENT(IN) :: ld_vel3d      ! Switch for zonal and meridional velocity components 
     917      LOGICAL, INTENT(IN) :: ld_nea        ! Switch for rejecting observation near land 
     918      LOGICAL, INTENT(IN) :: ld_dailyav    ! Switch for daily average data 
    942919      !! * Local declarations 
    943       INTEGER ::         &     
    944          & iyea0,        &    ! Initial date 
    945          & imon0,        &    !  - (year, month, day, hour, minute) 
    946          & iday0,        &     
    947          & ihou0,        &     
    948          & imin0 
    949       INTEGER ::         & 
    950          & icycle,       &    ! Current assimilation cycle 
     920      INTEGER :: iyea0        ! Initial date 
     921      INTEGER :: imon0        !  - (year, month, day, hour, minute) 
     922      INTEGER :: iday0     
     923      INTEGER :: ihou0     
     924      INTEGER :: imin0 
     925      INTEGER :: icycle       ! Current assimilation cycle 
    951926                              ! Counters for observations that 
    952          & iotdobs,      &    !  - outside time domain 
    953          & iosduobs,     &    !  - outside space domain (zonal velocity component) 
    954          & iosdvobs,     &    !  - outside space domain (meridional velocity component) 
    955          & ilanuobs,     &    !  - within a model land cell (zonal velocity component) 
    956          & ilanvobs,     &    !  - within a model land cell (meridional velocity component) 
    957          & inlauobs,     &    !  - close to land (zonal velocity component) 
    958          & inlavobs,     &    !  - close to land (meridional velocity component) 
    959          & igrdobs,      &    !  - fail the grid search 
    960          & iuvchku,      &    !  - reject u if v rejected and vice versa 
    961          & iuvchkv,      &    ! 
     927      INTEGER :: iotdobs      !  - outside time domain 
     928      INTEGER :: iosduobs     !  - outside space domain (zonal velocity component) 
     929      INTEGER :: iosdvobs     !  - outside space domain (meridional velocity component) 
     930      INTEGER :: ilanuobs     !  - within a model land cell (zonal velocity component) 
     931      INTEGER :: ilanvobs     !  - within a model land cell (meridional velocity component) 
     932      INTEGER :: inlauobs     !  - close to land (zonal velocity component) 
     933      INTEGER :: inlavobs     !  - close to land (meridional velocity component) 
     934      INTEGER :: igrdobs      !  - fail the grid search 
     935      INTEGER :: iuvchku      !  - reject u if v rejected and vice versa 
     936      INTEGER :: iuvchkv      ! 
    962937                              ! Global counters for observations that 
    963          & iotdobsmpp,   &    !  - outside time domain 
    964          & iosduobsmpp,  &    !  - outside space domain (zonal velocity component) 
    965          & iosdvobsmpp,  &    !  - outside space domain (meridional velocity component) 
    966          & ilanuobsmpp,  &    !  - within a model land cell (zonal velocity component) 
    967          & ilanvobsmpp,  &    !  - within a model land cell (meridional velocity component) 
    968          & inlauobsmpp,  &    !  - close to land (zonal velocity component) 
    969          & inlavobsmpp,  &    !  - close to land (meridional velocity component) 
    970          & igrdobsmpp,   &    !  - fail the grid search 
    971          & iuvchkumpp,   &    !  - reject u if v rejected and vice versa 
    972          & iuvchkvmpp         ! 
    973       TYPE(obs_prof_valid) :: & 
    974          & llvalid            ! Profile selection  
     938      INTEGER :: iotdobsmpp   !  - outside time domain 
     939      INTEGER :: iosduobsmpp  !  - outside space domain (zonal velocity component) 
     940      INTEGER :: iosdvobsmpp  !  - outside space domain (meridional velocity component) 
     941      INTEGER :: ilanuobsmpp  !  - within a model land cell (zonal velocity component) 
     942      INTEGER :: ilanvobsmpp  !  - within a model land cell (meridional velocity component) 
     943      INTEGER :: inlauobsmpp  !  - close to land (zonal velocity component) 
     944      INTEGER :: inlavobsmpp  !  - close to land (meridional velocity component) 
     945      INTEGER :: igrdobsmpp   !  - fail the grid search 
     946      INTEGER :: iuvchkumpp   !  - reject u if v rejected and vice versa 
     947      INTEGER :: iuvchkvmpp   ! 
     948      TYPE(obs_prof_valid) ::  llvalid      ! Profile selection  
    975949      TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: & 
    976950         & llvvalid           ! U,V selection  
    977       INTEGER :: &             
    978          & jvar,         &    ! Variable loop variable 
    979          & jobs,         &    ! Obs. loop variable 
    980          & jstp,         &    ! Time loop variable 
    981          & inrc               ! Time index variable 
     951      INTEGER :: jvar         ! Variable loop variable 
     952      INTEGER :: jobs         ! Obs. loop variable 
     953      INTEGER :: jstp         ! Time loop variable 
     954      INTEGER :: inrc         ! Time index variable 
    982955 
    983956      IF(lwp) WRITE(numout,*)'obs_pre_vel: Preparing the velocity profile data' 
    … …  
    11801153                  &                        prodatqc%npvsta(jobs,jvar) + 1 ) 
    11811154            ENDIF 
    1182          ENDDO 
    1183       ENDDO 
     1155         END DO 
     1156      END DO 
    11841157       
    11851158       
    … …  
    11901163            &                       prodatqc%nvstpmpp(:,jvar), & 
    11911164            &                       nitend - nit000 + 2 ) 
    1192       ENDDO 
     1165      END DO 
    11931166 
    11941167      IF ( lwp ) THEN 
    … …  
    12401213         & rhhmm                         
    12411214      !! * Arguments 
    1242       INTEGER, INTENT(IN) :: & 
    1243          & kcycle,   &      ! Current cycle 
    1244          & kyea0,    &      ! Initial date coordinates 
    1245          & kmon0,    & 
    1246          & kday0,    &  
    1247          & khou0,    & 
    1248          & kmin0,    & 
    1249          & kobsno           ! Number of observations 
    1250       INTEGER, INTENT(INOUT) :: & 
    1251          & kotdobs          ! Number of observations failing time check 
     1215      INTEGER, INTENT(IN) :: kcycle     ! Current cycle 
     1216      INTEGER, INTENT(IN) :: kyea0      ! Initial date coordinates 
     1217      INTEGER, INTENT(IN) :: kmon0 
     1218      INTEGER, INTENT(IN) :: kday0  
     1219      INTEGER, INTENT(IN) :: khou0 
     1220      INTEGER, INTENT(IN) :: kmin0 
     1221      INTEGER, INTENT(IN) :: kobsno     ! Number of observations 
     1222      INTEGER, INTENT(INOUT) :: kotdobs   ! Number of observations failing time check 
    12521223      INTEGER, DIMENSION(kobsno), INTENT(IN ) :: & 
    12531224         & kobsyea,  &      ! Observation time coordinates 
    … …  
    12631234 
    12641235      !! * Local declarations 
    1265       INTEGER :: & 
    1266          & jyea, & 
    1267          & jmon, & 
    1268          & jday, & 
    1269          & jobs 
    1270       INTEGER :: & 
    1271          & iyeastr, & 
    1272          & iyeaend, & 
    1273          & imonstr, &   
    1274          & imonend, & 
    1275          & idaystr, & 
    1276          & idayend, &  
    1277          & iskip,   & 
    1278          & idaystp 
    1279       REAL(KIND=wp) :: & 
    1280          & zminstp, & 
    1281          & zhoustp, & 
    1282          & zobsstp  
     1236      INTEGER :: jyea 
     1237      INTEGER :: jmon 
     1238      INTEGER :: jday 
     1239      INTEGER :: jobs 
     1240      INTEGER :: iyeastr 
     1241      INTEGER :: iyeaend 
     1242      INTEGER :: imonstr 
     1243      INTEGER :: imonend 
     1244      INTEGER :: idaystr 
     1245      INTEGER :: idayend  
     1246      INTEGER :: iskip 
     1247      INTEGER :: idaystp 
     1248      REAL(KIND=wp) :: zminstp 
     1249      REAL(KIND=wp) :: zhoustp 
     1250      REAL(KIND=wp) :: zobsstp  
    12831251      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year 
    12841252  
    … …  
    13731341         ENDIF 
    13741342 
    1375       ENDDO 
     1343      END DO 
    13761344 
    13771345   END SUBROUTINE obs_coo_tim 
    … …  
    14351403      !! * Modules used 
    14361404      !! * Arguments 
    1437       INTEGER, INTENT(IN) :: & 
    1438          & kcycle,   &      ! Current cycle 
    1439          & kyea0,    &      ! Initial date coordinates 
    1440          & kmon0,    & 
    1441          & kday0,    &  
    1442          & khou0,    & 
    1443          & kmin0,    & 
    1444          & kobsno           ! Number of observations 
    1445       INTEGER, INTENT(INOUT) :: & 
    1446          & kotdobs          ! Number of observations failing time check 
     1405      INTEGER, INTENT(IN) :: kcycle      ! Current cycle 
     1406      INTEGER, INTENT(IN) :: kyea0       ! Initial date coordinates 
     1407      INTEGER, INTENT(IN) :: kmon0 
     1408      INTEGER, INTENT(IN) :: kday0 
     1409      INTEGER, INTENT(IN) :: khou0 
     1410      INTEGER, INTENT(IN) :: kmin0 
     1411      INTEGER, INTENT(IN) :: kobsno      ! Number of observations 
     1412      INTEGER, INTENT(INOUT) ::  kotdobs    ! Number of observations failing time check 
    14471413      INTEGER, DIMENSION(kobsno), INTENT(IN ) :: & 
    14481414         & kobsyea,  &      ! Observation time coordinates 
    … …  
    14591425      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    14601426         & kdailyavtypes    ! Types for daily averages 
    1461       LOGICAL, OPTIONAL :: & 
    1462          & ld_dailyav       ! All types are daily averages 
     1427      LOGICAL, OPTIONAL :: ld_dailyav    ! All types are daily averages 
    14631428      !! * Local declarations 
    1464       INTEGER :: & 
    1465          & jobs 
     1429      INTEGER :: jobs 
    14661430 
    14671431      !----------------------------------------------------------------------- 
    … …  
    14921456                
    14931457            ENDIF 
    1494          ENDDO 
     1458         END DO 
    14951459      ENDIF 
    14961460 
    … …  
    15121476                   
    15131477               ENDIF 
    1514             ENDDO 
     1478            END DO 
    15151479         ENDIF 
    15161480      ENDIF 
    … …  
    15341498      !!---------------------------------------------------------------------- 
    15351499      !! * Arguments 
    1536       INTEGER, INTENT(IN) :: & 
    1537          & kobsno           ! Number of observations 
     1500      INTEGER, INTENT(IN) :: kobsno        ! Number of observations 
    15381501      INTEGER, DIMENSION(kobsno), INTENT(IN ) :: & 
    15391502         & kobsi, &         ! i,j indeces previously computed 
    15401503         & kobsj 
    1541       INTEGER, INTENT(INOUT) :: & 
    1542          & kgrdobs          ! Number of observations failing the check 
     1504      INTEGER, INTENT(INOUT) ::  kgrdobs   ! Number of observations failing the check 
    15431505      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: & 
    15441506         & kobsqc           ! Quality control flag 
    15451507 
    15461508      !! * Local declarations 
    1547       INTEGER :: & 
    1548          & jobs             ! Loop variable 
     1509      INTEGER :: jobs       ! Loop variable 
    15491510 
    15501511      ! Flag if the grid search failed 
    … …  
    15551516            kgrdobs = kgrdobs + 1 
    15561517         ENDIF 
    1557       ENDDO 
     1518      END DO 
    15581519       
    15591520   END SUBROUTINE obs_coo_grd 
    … …  
    15811542 
    15821543      !! * Arguments 
    1583       INTEGER, INTENT(IN) :: & 
    1584          & kobsno,  &         ! Total number of observations 
    1585          & kpi,     &         ! Number of grid points in (i,j) 
    1586          & kpj 
     1544      INTEGER, INTENT(IN) :: kobsno    ! Total number of observations 
     1545      INTEGER, INTENT(IN) :: kpi       ! Number of grid points in (i,j) 
     1546      INTEGER, INTENT(IN) :: kpj 
    15871547      INTEGER, DIMENSION(kobsno), INTENT(IN) :: & 
    15881548         & kobsi, &           ! Observation (i,j) coordinates 
    … …  
    15911551         & pobslam, &         ! Observation (lon,lat) coordinates 
    15921552         & pobsphi 
    1593       REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(INOUT) :: & 
     1553      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: & 
    15941554         & plam, pphi         ! Model (lon,lat) coordinates 
    15951555      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: & 
    … …  
    15971557      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: & 
    15981558         & kobsqc             ! Observation quality control 
    1599       INTEGER, INTENT(INOUT) :: & 
    1600          & kosdobs, &         ! Observations outside space domain 
    1601          & klanobs, &         ! Observations within a model land cell 
    1602          & knlaobs            ! Observations near land 
    1603       LOGICAL, INTENT(IN) :: & 
    1604          & ld_nea             ! Flag observations near land 
     1559      INTEGER, INTENT(INOUT) :: kosdobs   ! Observations outside space domain 
     1560      INTEGER, INTENT(INOUT) :: klanobs   ! Observations within a model land cell 
     1561      INTEGER, INTENT(INOUT) :: knlaobs   ! Observations near land 
     1562      LOGICAL, INTENT(IN) :: ld_nea       ! Flag observations near land 
    16051563      !! * Local declarations 
    16061564      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
    16071565         & zgmsk              ! Grid mask 
     1566      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
     1567         & zglam, &           ! Model longitude at grid points 
     1568         & zgphi              ! Model latitude at grid points 
    16081569      INTEGER, DIMENSION(2,2,kobsno) :: & 
    16091570         & igrdi, &           ! Grid i,j 
    16101571         & igrdj 
    1611       INTEGER :: & 
    1612          & jobs 
     1572      LOGICAL :: lgridobs           ! Is observation on a model grid point. 
     1573      INTEGER :: iig, ijg           ! i,j of observation on model grid point. 
     1574      INTEGER :: jobs, ji, jj 
    16131575       
    16141576      ! Get grid point indices 
    … …  
    16421604         ENDIF 
    16431605 
    1644       ENDDO 
     1606      END DO 
    16451607       
    16461608      CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pmask, zgmsk ) 
     1609      CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, plam, zglam ) 
     1610      CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pphi, zgphi ) 
    16471611 
    16481612      DO jobs = 1, kobsno 
    … …  
    16671631            CYCLE 
    16681632         ENDIF 
    1669              
     1633 
     1634         ! Check if this observation is on a grid point 
     1635 
     1636         lgridobs = .FALSE. 
     1637         iig = -1 
     1638         ijg = -1 
     1639         DO jj = 1, 2 
     1640            DO ji = 1, 2 
     1641               IF ( ( ABS( zgphi(ji,jj,jobs) - pobsphi(jobs) ) < 1.0e-6_wp ) & 
     1642                  & .AND. & 
     1643                  & ( ABS( zglam(ji,jj,jobs) - pobslam(jobs) ) < 1.0e-6_wp ) & 
     1644                  & ) THEN 
     1645                  lgridobs = .TRUE. 
     1646                  iig = ji 
     1647                  ijg = jj 
     1648               ENDIF 
     1649            END DO 
     1650         END DO 
     1651   
     1652         ! For observations on the grid reject them if their are at 
     1653         ! a masked point 
     1654          
     1655         IF (lgridobs) THEN 
     1656            IF (zgmsk(iig,ijg,jobs) == 0.0_wp ) THEN 
     1657               kobsqc(jobs) = kobsqc(jobs) + 12 
     1658               klanobs = klanobs + 1 
     1659               CYCLE 
     1660            ENDIF 
     1661         ENDIF 
     1662                       
    16701663         ! Flag if the observation falls is close to land 
    16711664         IF ( MINVAL( zgmsk(1:2,1:2,jobs) ) == 0.0_wp) THEN 
    … …  
    17111704 
    17121705      !! * Arguments 
    1713       INTEGER, INTENT(IN) :: & 
    1714          & kprofno, &         ! Number of profiles 
    1715          & kobsno,  &         ! Total number of observations 
    1716          & kpi,     &         ! Number of grid points in (i,j,k) 
    1717          & kpj,     & 
    1718          & kpk     
     1706      INTEGER, INTENT(IN) :: kprofno      ! Number of profiles 
     1707      INTEGER, INTENT(IN) :: kobsno       ! Total number of observations 
     1708      INTEGER, INTENT(IN) :: kpi          ! Number of grid points in (i,j,k) 
     1709      INTEGER, INTENT(IN) :: kpj 
     1710      INTEGER, INTENT(IN) :: kpk     
    17191711      INTEGER, DIMENSION(kprofno), INTENT(IN) :: & 
    17201712         & kpstart, &         ! Start of individual profiles 
    … …  
    17301722      REAL(KIND=wp), DIMENSION(kobsno), INTENT(INOUT) :: & 
    17311723         & pobsdep            ! Observation depths   
    1732       REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(INOUT) :: & 
     1724      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: & 
    17331725         & plam, pphi         ! Model (lon,lat) coordinates 
    17341726      REAL(KIND=wp), DIMENSION(kpk), INTENT(IN) :: & 
    … …  
    17401732      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: & 
    17411733         & kobsqc             ! Observation quality control 
    1742       INTEGER, INTENT(INOUT) :: & 
    1743          & kosdobs, &         ! Observations outside space domain 
    1744          & klanobs, &         ! Observations within a model land cell 
    1745          & knlaobs            ! Observations near land 
    1746       LOGICAL, INTENT(IN) :: & 
    1747          & ld_nea             ! Flag observations near land 
     1734      INTEGER, INTENT(INOUT) :: kosdobs     ! Observations outside space domain 
     1735      INTEGER, INTENT(INOUT) :: klanobs     ! Observations within a model land cell 
     1736      INTEGER, INTENT(INOUT) :: knlaobs     ! Observations near land 
     1737      LOGICAL, INTENT(IN) :: ld_nea         ! Flag observations near land 
    17481738      !! * Local declarations 
    17491739      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & 
    17501740         & zgmsk              ! Grid mask 
     1741      REAL(KIND=wp), DIMENSION(2,2,kprofno) :: & 
     1742         & zglam, &           ! Model longitude at grid points 
     1743         & zgphi              ! Model latitude at grid points 
    17511744      INTEGER, DIMENSION(2,2,kprofno) :: & 
    17521745         & igrdi, &           ! Grid i,j 
    17531746         & igrdj 
    1754       INTEGER :: & 
    1755          & jobs, jobsp, jk 
     1747      LOGICAL :: lgridobs           ! Is observation on a model grid point. 
     1748      INTEGER :: iig, ijg           ! i,j of observation on model grid point. 
     1749      INTEGER :: jobs, jobsp, jk, ji, jj 
    17561750 
    17571751      ! Get grid point indices 
    … …  
    17851779         ENDIF 
    17861780          
    1787       ENDDO 
     1781      END DO 
    17881782       
    17891783      CALL obs_int_comm_3d( 2, 2, kprofno, kpk, igrdi, igrdj, pmask, zgmsk ) 
     1784      CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, plam, zglam ) 
     1785      CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, pphi, zgphi ) 
    17901786 
    17911787      DO jobs = 1, kprofno 
    … …  
    17931789         ! Skip bad profiles 
    17941790         IF ( kpobsqc(jobs) >= 10 ) CYCLE 
     1791 
     1792         ! Check if this observation is on a grid point 
     1793 
     1794         lgridobs = .FALSE. 
     1795         iig = -1 
     1796         ijg = -1 
     1797         DO jj = 1, 2 
     1798            DO ji = 1, 2 
     1799               IF ( ( ABS( zgphi(ji,jj,jobs) - pobsphi(jobs) ) < 1.0e-6_wp ) & 
     1800                  & .AND. & 
     1801                  & ( ABS( zglam(ji,jj,jobs) - pobslam(jobs) ) < 1.0e-6_wp ) & 
     1802                  & ) THEN 
     1803                  lgridobs = .TRUE. 
     1804                  iig = ji 
     1805                  ijg = jj 
     1806               ENDIF 
     1807            END DO 
     1808         END DO 
     1809 
     1810         ! Reject observations 
    17951811 
    17961812         DO jobsp = kpstart(jobs), kpend(jobs) 
    … …  
    18151831               CYCLE 
    18161832            ENDIF 
     1833 
     1834            ! For observations on the grid reject them if their are at 
     1835            ! a masked point 
     1836             
     1837            IF (lgridobs) THEN 
     1838               IF (zgmsk(iig,ijg,kobsk(jobsp)-1,jobs) == 0.0_wp ) THEN 
     1839                  kobsqc(jobsp) = kobsqc(jobsp) + 12 
     1840                  klanobs = klanobs + 1 
     1841                  CYCLE 
     1842               ENDIF 
     1843            ENDIF 
    18171844             
    18181845            ! Flag if the observation falls is close to land 
    … …  
    18281855            ENDIF 
    18291856             
    1830          ENDDO 
    1831       ENDDO 
     1857         END DO 
     1858      END DO 
    18321859 
    18331860   END SUBROUTINE obs_coo_spc_3d 
    … …  
    18501877      !! * Modules used 
    18511878      !! * Arguments 
    1852       TYPE(obs_prof), INTENT(INOUT) :: & 
    1853          & profdata           ! Profile data 
     1879      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Profile data 
    18541880      !! * Local declarations 
    1855       INTEGER :: & 
    1856          & jprof, & 
    1857          & jvar,  & 
    1858          & jobs 
     1881      INTEGER :: jprof 
     1882      INTEGER :: jvar 
     1883      INTEGER :: jobs 
    18591884       
    18601885      ! Loop over profiles 
    … …  
    18721897                     & profdata%var(jvar)%nvqc(jobs) + 26 
    18731898 
    1874                ENDDO 
    1875  
    1876             ENDDO 
     1899               END DO 
     1900 
     1901            END DO 
    18771902 
    18781903         ENDIF 
    18791904 
    1880       ENDDO 
     1905      END DO 
    18811906 
    18821907   END SUBROUTINE obs_pro_rej 
    … …  
    18991924      !! * Modules used 
    19001925      !! * Arguments 
    1901       TYPE(obs_prof), INTENT(INOUT) :: & 
    1902          & profdata           ! Profile data 
    1903       INTEGER, INTENT(INOUT) :: & 
    1904          & knumu , &          ! Number of u rejected 
    1905          & knumv              ! Number of v rejected 
     1926      TYPE(obs_prof), INTENT(INOUT) :: profdata   ! Profile data 
     1927      INTEGER, INTENT(INOUT) :: knumu             ! Number of u rejected 
     1928      INTEGER, INTENT(INOUT) :: knumv             ! Number of v rejected 
    19061929      !! * Local declarations 
    1907       INTEGER :: & 
    1908          & jprof, & 
    1909          & jvar,  & 
    1910          & jobs 
     1930      INTEGER :: jprof 
     1931      INTEGER :: jvar 
     1932      INTEGER :: jobs 
    19111933       
    19121934      ! Loop over profiles 
    … …  
    19351957            ENDIF 
    19361958             
    1937          ENDDO 
     1959         END DO 
    19381960             
    1939       ENDDO 
     1961      END DO 
    19401962 
    19411963   END SUBROUTINE obs_uv_rej 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_prof_io.h90

    r2001 r2074  
    2121      LOGICAL          :: ldgrid     ! Save grid info in data structure 
    2222      !! * Local declarations 
    23       INTEGER  :: & 
    24          & iobs, &                   ! Number of observations 
    25          & ilev                      ! Number of levels 
    26       INTEGER :: & 
    27          & i_file_id,                & 
    28          & i_obs_id,                 & 
    29          & i_lev_id,                 & 
    30          & i_phi_id,                 &  
    31          & i_lam_id,                 & 
    32          & i_depth_id,               & 
    33          & i_var_id,                 & 
    34          & i_pl_num_id,              & 
    35          & i_reference_date_time_id, &  
    36          & i_format_version_id,      & 
    37          & i_juld_id,                & 
    38          & i_data_type_id,           & 
    39          & i_wmo_inst_type_id,       & 
    40          & i_qc_var_id,              & 
    41          & i_dc_ref_id,              & 
    42          & i_qc_flag_id 
    43       CHARACTER(LEN=40) :: &  
    44          & cl_fld_lam,                 & 
    45          & cl_fld_phi,                 & 
    46          & cl_fld_depth,               &  
    47          & cl_fld_var_tp,              & 
    48          & cl_fld_var_s,               & 
    49          & cl_fld_var_ti,              & 
    50          & cl_fld_var_juld_qc,         & 
    51          & cl_fld_var_pos_qc,          & 
    52          & cl_fld_var_depth_qc,        &  
    53          & cl_fld_var_qc_t,            & 
    54          & cl_fld_var_qc_s,            & 
    55          & cl_fld_var_prof_qc_t,       & 
    56          & cl_fld_var_prof_qc_s,       & 
    57          & cl_fld_reference_date_time, &  
    58          & cl_fld_juld,                & 
    59          & cl_fld_data_type,           & 
    60          & cl_fld_pl_num,              & 
    61          & cl_fld_format_version,      & 
    62          & cl_fld_wmo_inst_type,       & 
    63          & cl_fld_qc_flags_profiles,   & 
    64          & cl_fld_qc_flags_levels 
    65  
    66       CHARACTER(LEN=14), PARAMETER :: & 
    67          & cl_name = 'read_enactfile' 
    68       CHARACTER(LEN=16)            :: & 
    69          & cl_data_type = '' 
    70       CHARACTER(LEN=4 )            :: & 
    71          & cl_format_version = '' 
    72       INTEGER, DIMENSION(1) :: & 
    73          & istart1, icount1 
    74       INTEGER, DIMENSION(2) :: & 
    75          & istart2, icount2 
    76       CHARACTER(len=imaxlev) :: & 
    77          & clqc 
    78       CHARACTER(len=1) :: & 
    79          & cqc 
    80       INTEGER :: & 
    81          & ji, jk 
    82       INTEGER, ALLOCATABLE, DIMENSION(:) :: & 
    83          & iqc1 
    84       INTEGER, ALLOCATABLE, DIMENSION(:,:) :: & 
    85          & iqc2 
     23      INTEGER :: iobs                ! Number of observations 
     24      INTEGER :: ilev                      ! Number of levels 
     25      INTEGER :: i_file_id 
     26      INTEGER :: i_obs_id 
     27      INTEGER :: i_lev_id 
     28      INTEGER :: i_phi_id 
     29      INTEGER :: i_lam_id 
     30      INTEGER :: i_depth_id 
     31      INTEGER :: i_var_id 
     32      INTEGER :: i_pl_num_id 
     33      INTEGER :: i_reference_date_time_id 
     34      INTEGER :: i_format_version_id 
     35      INTEGER :: i_juld_id 
     36      INTEGER :: i_data_type_id 
     37      INTEGER :: i_wmo_inst_type_id 
     38      INTEGER :: i_qc_var_id 
     39      INTEGER :: i_dc_ref_id 
     40      INTEGER :: i_qc_flag_id 
     41      CHARACTER(LEN=40) :: cl_fld_lam 
     42      CHARACTER(LEN=40) :: cl_fld_phi 
     43      CHARACTER(LEN=40) :: cl_fld_depth  
     44      CHARACTER(LEN=40) :: cl_fld_var_tp 
     45      CHARACTER(LEN=40) :: cl_fld_var_s 
     46      CHARACTER(LEN=40) :: cl_fld_var_ti 
     47      CHARACTER(LEN=40) :: cl_fld_var_juld_qc 
     48      CHARACTER(LEN=40) :: cl_fld_var_pos_qc 
     49      CHARACTER(LEN=40) :: cl_fld_var_depth_qc  
     50      CHARACTER(LEN=40) :: cl_fld_var_qc_t 
     51      CHARACTER(LEN=40) :: cl_fld_var_qc_s 
     52      CHARACTER(LEN=40) :: cl_fld_var_prof_qc_t 
     53      CHARACTER(LEN=40) :: cl_fld_var_prof_qc_s 
     54      CHARACTER(LEN=40) :: cl_fld_reference_date_time 
     55      CHARACTER(LEN=40) :: cl_fld_juld 
     56      CHARACTER(LEN=40) :: cl_fld_data_type 
     57      CHARACTER(LEN=40) :: cl_fld_pl_num 
     58      CHARACTER(LEN=40) :: cl_fld_format_version 
     59      CHARACTER(LEN=40) :: cl_fld_wmo_inst_type 
     60      CHARACTER(LEN=40) :: cl_fld_qc_flags_profiles 
     61      CHARACTER(LEN=40) :: cl_fld_qc_flags_levels 
     62 
     63      CHARACTER(LEN=14), PARAMETER :: cl_name = 'read_enactfile' 
     64      CHARACTER(LEN=16)            :: cl_data_type = '' 
     65      CHARACTER(LEN=4 )            :: cl_format_version = '' 
     66      INTEGER, DIMENSION(1) :: istart1, icount1 
     67      INTEGER, DIMENSION(2) :: istart2, icount2 
     68      CHARACTER(len=imaxlev) :: clqc 
     69      CHARACTER(len=1) :: cqc 
     70      INTEGER :: ji, jk 
     71      INTEGER, ALLOCATABLE, DIMENSION(:) :: iqc1 
     72      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iqc2 
    8673 
    8774      !----------------------------------------------------------------------- 
    … …  
    207194         DO jk = 1, ilev 
    208195            inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' ) 
    209          ENDDO 
    210       ENDDO 
     196         END DO 
     197      END DO 
    211198      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ),                         & 
    212199         &         cl_name, __LINE__ ) 
    … …  
    218205         DO jk = 1, ilev 
    219206            inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' ) 
    220          ENDDO 
    221       ENDDO 
     207         END DO 
     208      END DO 
    222209      ! No depth QC in files 
    223210      DO ji = 1, iobs 
    … …  
    225212            inpfile%idqc(jk,ji)  = 1 
    226213            inpfile%idqcf(:,jk,ji) = 0 
    227          ENDDO 
    228       ENDDO 
     214         END DO 
     215      END DO 
    229216 
    230217      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ),                    & 
    … …  
    236223            &         cl_name, __LINE__ ) 
    237224         inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' ) 
    238       ENDDO 
     225      END DO 
    239226      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ),                    &  
    240227         &         cl_name, __LINE__ )  
    … …  
    245232            &         cl_name, __LINE__ ) 
    246233         inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' ) 
    247       ENDDO 
     234      END DO 
    248235!!      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_juld_qc, i_qc_var_id ),                       & 
    249236!!         &         cl_name, __LINE__ )  
    … …  
    255242!!         inpfile%itqc(ji)    = IACHAR( cqc ) - IACHAR( '0' ) 
    256243!!         inpfile%itqcf(:,ji) = 0 
    257 !!      ENDDO 
     244!!      END DO 
    258245      ! Since the flags are not set in the ENACT files we reset them to 0 
    259246      inpfile%itqc(:)    = 1       
    … …  
    268255         inpfile%ipqc(ji)    = IACHAR( cqc ) - IACHAR( '0' ) 
    269256         inpfile%ipqcf(:,ji) = 0 
    270       ENDDO 
     257      END DO 
    271258      DO ji = 1,iobs 
    272259         inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) ) 
    273       ENDDO 
     260      END DO 
    274261      IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_profiles, i_qc_flag_id ) == nf90_noerr ) THEN 
    275262         ALLOCATE( & 
    … …  
    283270            inpfile%ioqcf(2,ji)   = 0 
    284271            inpfile%ivqcf(2,ji,:) = 0 
    285          ENDDO 
     272         END DO 
    286273         DEALLOCATE( & 
    287274            & iqc1 & 
    … …  
    302289               inpfile%ivlqcf(1,jk,ji,:) = iqc2(jk,ji) 
    303290               inpfile%ivlqcf(2,jk,ji,:) = 0 
    304             ENDDO 
    305          ENDDO 
     291            END DO 
     292         END DO 
    306293         DEALLOCATE( & 
    307294            & iqc2 & 
    … …  
    385372      DO ji = 1, inpfile%nobs 
    386373         inpfile%kindex(ji) = ji 
    387       ENDDO 
     374      END DO 
    388375 
    389376   END SUBROUTINE read_enactfile 
    … …  
    611598         DO jk = 1, ilev 
    612599            inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' ) 
    613          ENDDO 
    614       ENDDO 
     600         END DO 
     601      END DO 
    615602      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ) == nf90_noerr ) THEN 
    616603         DO ji = 1, iobs 
    … …  
    621608            DO jk = 1, ilev 
    622609               inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' ) 
    623             ENDDO 
    624          ENDDO 
     610            END DO 
     611         END DO 
    625612      ELSE 
    626613         inpfile%ivlqc(:,:,2) = 4 
    … …  
    637624            &         cl_name, __LINE__ ) 
    638625         inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' ) 
    639       ENDDO 
     626      END DO 
    640627      IF (lsal) THEN 
    641628         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ),                 &  
    … …  
    647634               &         cl_name, __LINE__ ) 
    648635            inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' ) 
    649          ENDDO 
     636         END DO 
    650637      ELSE 
    651638         inpfile%ivqc(:,2) = 4 
    … …  
    653640      DO ji = 1,iobs 
    654641         inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) ) 
    655       ENDDO 
     642      END DO 
    656643      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ),                       & 
    657644         &         cl_name, __LINE__ )  
    … …  
    662649            &         cl_name, __LINE__ ) 
    663650         inpfile%ipqc(ji)  = IACHAR( cqc ) - IACHAR( '0' ) 
    664       ENDDO 
     651      END DO 
    665652       
    666653      !--------------------------------------------------------------------- 
    … …  
    693680            DO jk = 1, ilev 
    694681               inpfile%idqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' ) 
    695             ENDDO 
    696          ENDDO 
     682            END DO 
     683         END DO 
    697684      ELSE 
    698685         inpfile%pdep(:,:) = fbrmdi 
    … …  
    712699            DO jk = 1, ilev 
    713700               ipresqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' ) 
    714             ENDDO 
    715          ENDDO 
     701            END DO 
     702         END DO 
    716703      ELSE 
    717704         zpres(:,:) = fbrmdi 
    … …  
    771758      DO ji = 1, inpfile%nobs 
    772759         inpfile%kindex(ji) = ji 
    773       ENDDO 
     760      END DO 
    774761       
    775762      !--------------------------------------------------------------------- 
    … …  
    789776                  ENDIF 
    790777               ENDIF 
    791             ENDDO 
     778            END DO 
    792779         ENDIF 
    793       ENDDO 
     780      END DO 
    794781       
    795782      !--------------------------------------------------------------------- 
    … …  
    806793                  ENDIF 
    807794               ENDIF 
    808             ENDDO 
     795            END DO 
    809796         ENDIF 
    810       ENDDO 
     797      END DO 
    811798       
    812799      !--------------------------------------------------------------------- 
    … …  
    826813               inpfile%pob(jk,ji,1) = fbrmdi 
    827814            ENDIF 
    828          ENDDO 
    829       ENDDO 
     815         END DO 
     816      END DO 
    830817 
    831818      !--------------------------------------------------------------------- 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_profiles_def.F90

    r2001 r2074  
    5050   TYPE obs_prof_valid 
    5151       
    52       LOGICAL, POINTER, DIMENSION(:) :: & 
    53          luse 
     52      LOGICAL, POINTER, DIMENSION(:) :: luse 
    5453 
    5554   END TYPE obs_prof_valid 
    … …  
    9291      ! Bookkeeping 
    9392 
    94       INTEGER :: & 
    95          & nvar,     &    !: Number of variables 
    96          & next,     &    !: Number of extra fields 
    97          & nprof,    &    !: Total number of profiles within window. 
    98          & nstp,     &    !: Number of time steps 
    99          & npi,      &    !: Number of 3D grid points 
    100          & npj,      & 
    101          & npk,      & 
    102          & nprofup        !: Observation counter used in obs_oper 
     93      INTEGER :: nvar     !: Number of variables 
     94      INTEGER :: next     !: Number of extra fields 
     95      INTEGER :: nprof    !: Total number of profiles within window. 
     96      INTEGER :: nstp     !: Number of time steps 
     97      INTEGER :: npi      !: Number of 3D grid points 
     98      INTEGER :: npj 
     99      INTEGER :: npk 
     100      INTEGER :: nprofup  !: Observation counter used in obs_oper 
    103101 
    104102      ! Bookkeeping arrays with sizes equal to number of variables 
    … …  
    155153      ! Arrays of variables 
    156154 
    157       TYPE(obs_prof_var), POINTER, DIMENSION(:) :: & 
    158          & var 
     155      TYPE(obs_prof_var), POINTER, DIMENSION(:) :: var 
    159156 
    160157      ! Arrays with size equal to the number of time steps in the window 
    … …  
    203200      !!---------------------------------------------------------------------- 
    204201      !! * Arguments 
    205       TYPE(obs_prof), INTENT(INOUT) :: & 
    206          & prof      ! Profile data to be allocated 
    207       INTEGER, INTENT(IN) :: & 
    208          & kprof, &  ! Number of profiles 
    209          & kvar,  &  ! Number of variables 
    210          & kext      ! Number of extra fields within each variable 
     202      TYPE(obs_prof), INTENT(INOUT) :: prof      ! Profile data to be allocated 
     203      INTEGER, INTENT(IN) :: kprof  ! Number of profiles 
     204      INTEGER, INTENT(IN) :: kvar   ! Number of variables 
     205      INTEGER, INTENT(IN) :: kext   ! Number of extra fields within each variable 
    211206      INTEGER, INTENT(IN), DIMENSION(kvar) :: & 
    212207         & ko3dt     ! Number of observations per variables 
    213       INTEGER, INTENT(IN) :: & 
    214          & kstp,  &  ! Number of time steps 
    215          & kpi,   &  ! Number of 3D grid points 
    216          & kpj,   & 
    217          & kpk 
     208      INTEGER, INTENT(IN) :: kstp   ! Number of time steps 
     209      INTEGER, INTENT(IN) :: kpi    ! Number of 3D grid points 
     210      INTEGER, INTENT(IN) :: kpj 
     211      INTEGER, INTENT(IN) :: kpk 
    218212 
    219213      !!* Local variables 
    220       INTEGER :: & 
    221          & jvar, & 
    222          & ji 
     214      INTEGER :: jvar 
     215      INTEGER :: ji 
    223216 
    224217      ! Set bookkeeping variables 
    … …  
    243236         prof%nvprot   (jvar) = ko3dt(jvar) 
    244237         prof%nvprotmpp(jvar) = 0 
    245       ENDDO 
     238      END DO 
    246239 
    247240      ! Allocate arrays of size number of profiles 
    … …  
    303296         IF ( ko3dt(jvar) >= 0 ) THEN 
    304297            CALL obs_prof_alloc_var( prof, jvar, kext, ko3dt(jvar) ) 
    305          END IF 
     298         ENDIF 
    306299          
    307300      END DO 
    … …  
    333326      DO ji = 1, kprof 
    334327         prof%npind(ji) = ji 
    335       ENDDO 
     328      END DO 
    336329 
    337330      DO jvar = 1, kvar 
    338331         DO ji = 1, ko3dt(jvar) 
    339332            prof%var(jvar)%nvind(ji) = ji 
    340          ENDDO 
    341       ENDDO 
     333         END DO 
     334      END DO 
    342335 
    343336      ! Set defaults for number of observations per time step 
    … …  
    471464      !!        !  07-03  (K. Mogensen) Original code 
    472465      !! * Arguments 
    473       TYPE(obs_prof), INTENT(INOUT) :: & 
    474          & prof      ! Profile data to be allocated 
    475       INTEGER, INTENT(IN) :: & 
    476          & kvar, &   ! Variable number 
    477          & kext, &   ! Number of extra fields within each variable 
    478          & kobs      ! Number of observations 
     466      TYPE(obs_prof), INTENT(INOUT) :: prof   ! Profile data to be allocated 
     467      INTEGER, INTENT(IN) :: kvar   ! Variable number 
     468      INTEGER, INTENT(IN) :: kext   ! Number of extra fields within each variable 
     469      INTEGER, INTENT(IN) :: kobs   ! Number of observations 
    479470       
    480471      ALLOCATE( &  
    … …  
    513504      !!        !  07-03  (K. Mogensen) Original code 
    514505      !! * Arguments 
    515       TYPE(obs_prof), INTENT(INOUT) :: & 
    516          & prof      ! Profile data to be allocated 
    517       INTEGER, INTENT(IN) :: & 
    518          & kvar      ! Variable number 
     506      TYPE(obs_prof), INTENT(INOUT) :: prof   ! Profile data to be allocated 
     507      INTEGER, INTENT(IN) :: kvar      ! Variable number 
    519508       
    520509      DEALLOCATE( &  
    … …  
    559548      !!---------------------------------------------------------------------- 
    560549      !! * Arguments 
    561       TYPE(obs_prof), INTENT(IN)    :: & 
    562          & prof          ! Original profile 
    563       TYPE(obs_prof), INTENT(INOUT) :: & 
    564          & newprof       ! New profile with the copy of the data 
    565       LOGICAL :: & 
    566          & lallocate     ! Allocate newprof data 
    567       INTEGER,INTENT(IN) :: & 
    568          & kumout        ! Fortran unit for messages 
     550      TYPE(obs_prof), INTENT(IN)    :: prof      ! Original profile 
     551      TYPE(obs_prof), INTENT(INOUT) :: newprof   ! New profile with the copy of the data 
     552      LOGICAL :: lallocate                ! Allocate newprof data 
     553      INTEGER,INTENT(IN) :: kumout        ! Fortran unit for messages 
    569554      TYPE(obs_prof_valid), OPTIONAL, INTENT(in) :: & 
    570555         & lvalid        ! Valid profiles 
    … …  
    573558       
    574559      !!* Local variables 
    575       INTEGER :: & 
    576          & inprof 
     560      INTEGER :: inprof 
    577561      INTEGER, DIMENSION(prof%nvar) :: & 
    578562         & invpro 
    579       INTEGER :: & 
    580          & jvar, & 
    581          & jext, & 
    582          & ji,   & 
    583          & jj  
    584       LOGICAL :: & 
    585          & lfirst 
     563      INTEGER :: jvar 
     564      INTEGER :: jext 
     565      INTEGER :: ji 
     566      INTEGER :: jj  
     567      LOGICAL :: lfirst 
    586568      TYPE(obs_prof_valid) :: & 
    587569         & llvalid 
    588570      TYPE(obs_prof_valid), DIMENSION(prof%nvar) :: & 
    589571         & llvvalid 
    590       LOGICAL :: & 
    591          & lallpresent, & 
    592          & lnonepresent 
     572      LOGICAL :: lallpresent 
     573      LOGICAL :: lnonepresent 
    593574 
    594575      ! Check that either all or none of the masks are persent. 
    … …  
    619600                     IF ( lvvalid(jvar)%luse(jj) ) & 
    620601                        &           invpro(jvar) = invpro(jvar) +1 
    621                   ENDDO 
    622                ENDDO 
     602                  END DO 
     603               END DO 
    623604            ENDIF 
    624          ENDDO 
     605         END DO 
    625606      ELSE 
    626607         inprof    = prof%nprof 
    … …  
    643624      DO jvar = 1, prof%nvar 
    644625         ALLOCATE( llvvalid(jvar)%luse(prof%nvprot(jvar)) ) 
    645       ENDDO 
     626      END DO 
    646627      IF ( lallpresent ) THEN 
    647628         llvalid%luse(:) = lvalid%luse(:) 
    648629         DO jvar = 1, prof%nvar 
    649630            llvvalid(jvar)%luse(:) = lvvalid(jvar)%luse(:) 
    650          ENDDO 
     631         END DO 
    651632      ELSE 
    652633         llvalid%luse(:) = .TRUE. 
    653634         DO jvar = 1, prof%nvar 
    654635            llvvalid(jvar)%luse(:) = .TRUE. 
    655          ENDDO 
     636         END DO 
    656637      ENDIF 
    657638 
    … …  
    807788      !!---------------------------------------------------------------------- 
    808789      !! * Arguments 
    809       TYPE(obs_prof),INTENT(INOUT) :: & 
    810          & prof        ! Updated profile data 
    811       TYPE(obs_prof),INTENT(INOUT) :: & 
    812          & oldprof     ! Original profile data 
    813       LOGICAL :: & 
    814          & ldeallocate ! Deallocate the updated data of insertion 
    815       INTEGER,INTENT(in) :: & 
    816          & kumout      ! Output unit 
     790      TYPE(obs_prof),INTENT(INOUT) :: prof      ! Updated profile data 
     791      TYPE(obs_prof),INTENT(INOUT) :: oldprof   ! Original profile data 
     792      LOGICAL :: ldeallocate         ! Deallocate the updated data of insertion 
     793      INTEGER,INTENT(in) :: kumout   ! Output unit 
    817794       
    818795      !!* Local variables 
    819       INTEGER :: & 
    820          & jvar, & 
    821          & jext, & 
    822          & ji,   & 
    823          & jj,   & 
    824          & jk,   & 
    825          & jl 
     796      INTEGER :: jvar 
     797      INTEGER :: jext 
     798      INTEGER :: ji 
     799      INTEGER :: jj 
     800      INTEGER :: jk 
     801      INTEGER :: jl 
    826802 
    827803      DO ji = 1, prof%nprof 
    … …  
    878854                  oldprof%var(jvar)%vext(jl,jext) = & 
    879855                     &                        prof%var(jvar)%vext(jj,jext) 
    880                ENDDO 
     856               END DO 
    881857                
    882             ENDDO 
    883  
    884          ENDDO 
     858            END DO 
     859 
     860         END DO 
    885861          
    886       ENDDO 
     862      END DO 
    887863 
    888864      ! Optionally deallocate the updated profile data 
    … …  
    906882      !!---------------------------------------------------------------------- 
    907883      !! * Arguments 
    908       TYPE(obs_prof),INTENT(INOUT) :: & 
    909          & prof        ! Profile data 
    910       INTEGER,INTENT(IN) :: & 
    911          & kvarno      ! Variable number 
     884      TYPE(obs_prof),INTENT(INOUT) :: prof     ! Profile data 
     885      INTEGER,INTENT(IN) :: kvarno     ! Variable number 
    912886 
    913887      !!* Local variables 
    914       INTEGER :: & 
    915          & ji, & 
    916          & iprofno 
     888      INTEGER :: ji 
     889      INTEGER :: iprofno 
    917890 
    918891      !----------------------------------------------------------------------- 
    … …  
    928901         prof%npvend(iprofno,kvarno) = & 
    929902            & MAX( ji, prof%npvend(iprofno,kvarno) ) 
    930       ENDDO 
     903      END DO 
    931904 
    932905      DO ji = 1, prof%nprof 
    933906         IF ( prof%npvsta(ji,kvarno) == ( prof%nvprot(kvarno) + 1 ) ) & 
    934907            & prof%npvsta(ji,kvarno) = 0 
    935       ENDDO 
     908      END DO 
    936909 
    937910   END SUBROUTINE obs_prof_staend 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_read_altbias.F90

    r2001 r2074  
    6363 
    6464      !! * Arguments 
    65       INTEGER, INTENT(IN) :: & 
    66          & kslano          ! Number of SLA Products 
     65      INTEGER, INTENT(IN) :: kslano      ! Number of SLA Products 
    6766      TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: & 
    6867         & sladata       ! SLA data 
    69       INTEGER, INTENT(IN) :: & 
    70          & k2dint 
     68      INTEGER, INTENT(IN) :: k2dint 
    7169      CHARACTER(LEN=128) :: bias_file 
    7270 
    7371      !! * Local declarations 
    7472 
    75       CHARACTER(LEN=12), PARAMETER :: & 
    76          & cpname = 'obs_rea_altbias' 
    77  
    78       INTEGER :: & 
    79          & jslano,  &      ! Data set loop variable 
    80          & jobs,    &      ! Obs loop variable 
    81          & jpialtbias,  &      ! Number of grid point in latitude for the bias 
    82          & jpjaltbias,  &      ! Number of grid point in longitude for the bias 
    83          & iico,    &      ! Grid point indicies 
    84          & ijco 
    85       INTEGER :: &  
    86          & i_nx_id,     &  ! Index to read the NetCDF file 
    87          & i_ny_id,     &  !  
    88          & i_file_id,   &  !  
    89          & i_var_id 
     73      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_rea_altbias' 
     74 
     75      INTEGER :: jslano       ! Data set loop variable 
     76      INTEGER :: jobs         ! Obs loop variable 
     77      INTEGER :: jpialtbias   ! Number of grid point in latitude for the bias 
     78      INTEGER :: jpjaltbias   ! Number of grid point in longitude for the bias 
     79      INTEGER :: iico         ! Grid point indicies 
     80      INTEGER :: ijco 
     81      INTEGER :: i_nx_id      ! Index to read the NetCDF file 
     82      INTEGER :: i_ny_id      !  
     83      INTEGER :: i_file_id    !  
     84      INTEGER :: i_var_id 
    9085 
    9186      REAL(wp), DIMENSION(jpi,jpj) :: &  
    … …  
    10196         & zglam, & 
    10297         & zgphi 
    103       REAL(wp) :: & 
    104          & zlam, & 
    105          & zphi 
     98      REAL(wp) :: zlam 
     99      REAL(wp) :: zphi 
    106100      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
    107101         & igrdi, & 
    108102         & igrdj 
    109       INTEGER :: & 
    110          & numaltbias 
     103      INTEGER :: numaltbias 
    111104 
    112105      IF(lwp)WRITE(numout,*)  

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_read_prof.F90

    r2001 r2074  
    6060    
    6161      !! * Arguments 
    62       INTEGER :: & 
    63          & kformat        ! Format of input data 
    64       !                   ! 1: ENACT 
    65       !                   ! 2: Coriolis 
    66       TYPE(obs_prof), INTENT(OUT) :: & 
    67          & profdata       ! Profile data to be read 
    68       INTEGER, INTENT(IN) :: & 
    69          & knumfiles      ! Number of files to read in 
     62      INTEGER ::  kformat    ! Format of input data 
     63      !                      ! 1: ENACT 
     64      !                      ! 2: Coriolis 
     65      TYPE(obs_prof), INTENT(OUT) ::  profdata     ! Profile data to be read 
     66      INTEGER, INTENT(IN) :: knumfiles      ! Number of files to read in 
    7067      CHARACTER(LEN=128), INTENT(IN) ::  & 
    71          & cfilenames(knumfiles) ! File names to read in 
    72       INTEGER, INTENT(IN) ::  & 
    73          & kvars,  &      ! Number of variables in profdata 
    74          & kextr,  &      ! Number of extra fields for each var in profdata 
    75          & kstp           ! Ocean time-step index 
    76       LOGICAL, INTENT(IN) :: & 
    77          & ldt3d, &       ! Observed variables switches 
    78          & lds3d, & 
    79          & ldignmis, &    ! Ignore missing files 
    80          & ldsatt, &      ! Compute salinity at all temperature points 
    81          & ldavtimset, &  ! Correct time for daily averaged data 
    82          & ldmod          ! Initialize model from input data 
    83       REAL(KIND=dp), INTENT(IN) ::  & 
    84          & ddobsini, &    ! Obs. ini time in YYYYMMDD.HHMMSS 
    85          & ddobsend       ! Obs. end time in YYYYMMDD.HHMMSS 
     68         & cfilenames(knumfiles)  ! File names to read in 
     69      INTEGER, INTENT(IN) :: kvars      ! Number of variables in profdata 
     70      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var in profdata 
     71      INTEGER, INTENT(IN) :: kstp        ! Ocean time-step index 
     72      LOGICAL, INTENT(IN) :: ldt3d       ! Observed variables switches 
     73      LOGICAL, INTENT(IN) :: lds3d 
     74      LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files 
     75      LOGICAL, INTENT(IN) :: ldsatt      ! Compute salinity at all temperature points 
     76      LOGICAL, INTENT(IN) :: ldavtimset  ! Correct time for daily averaged data 
     77      LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data 
     78      REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS 
     79      REAL(KIND=dp), INTENT(IN) :: ddobsend    ! Obs. end time in YYYYMMDD.HHMMSS 
    8680      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    8781         & kdailyavtypes 
    … …  
    8983      !! * Local declarations 
    9084      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_pro_dri' 
    91       INTEGER :: & 
    92          & jvar, & 
    93          & ji,   & 
    94          & jj,   &  
    95          & jk 
    96       INTEGER :: & 
    97          & ij,        & 
    98          & iflag,     & 
    99          & inobf,     & 
    100          & i_file_id, & 
    101          & inowin,    & 
    102          & iyea,      & 
    103          & imon,      & 
    104          & iday,      & 
    105          & ihou,      & 
    106          & imin,      & 
    107          & isec 
     85      INTEGER :: jvar 
     86      INTEGER :: ji 
     87      INTEGER :: jj 
     88      INTEGER :: jk 
     89      INTEGER :: ij 
     90      INTEGER :: iflag 
     91      INTEGER :: inobf 
     92      INTEGER :: i_file_id 
     93      INTEGER :: inowin 
     94      INTEGER :: iyea 
     95      INTEGER :: imon 
     96      INTEGER :: iday 
     97      INTEGER :: ihou 
     98      INTEGER :: imin 
     99      INTEGER :: isec 
    108100      INTEGER, DIMENSION(knumfiles) :: & 
    109101         & irefdate 
    … …  
    113105         & ityps,    & 
    114106         & itypsmpp  
    115       INTEGER :: & 
    116          & it3dtmpp, & 
    117          & is3dtmpp, & 
    118          & ip3dtmpp 
     107      INTEGER :: it3dtmpp 
     108      INTEGER :: is3dtmpp 
     109      INTEGER :: ip3dtmpp 
    119110      INTEGER, DIMENSION(:), ALLOCATABLE :: & 
    120111         & iobsi,    & 
    … …  
    132123      REAL(dp), DIMENSION(:), ALLOCATABLE :: & 
    133124         & zdat 
    134       LOGICAL :: & 
    135          & llvalprof 
     125      LOGICAL :: llvalprof 
    136126      TYPE(obfbdata), POINTER, DIMENSION(:) :: & 
    137127         & inpfiles 
    … …  
    139129         & djulini, & 
    140130         & djulend 
    141       INTEGER :: & 
    142          & iprof,    & 
    143          & iproftot, & 
    144          & it3dt0,    & 
    145          & is3dt0,    & 
    146          & it3dt,    & 
    147          & is3dt,    & 
    148          & ip3dt 
     131      INTEGER :: iprof 
     132      INTEGER :: iproftot 
     133      INTEGER :: it3dt0 
     134      INTEGER :: is3dt0 
     135      INTEGER :: it3dt 
     136      INTEGER :: is3dt 
     137      INTEGER :: ip3dt 
    149138      INTEGER, DIMENSION(kvars) :: & 
    150139         & iv3dt 
    151       CHARACTER(len=8) :: & 
    152          & cl_refdate 
     140      CHARACTER(len=8) :: cl_refdate 
    153141    
    154142      ! Local initialization 
    … …  
    232220               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), & 
    233221                  &                ldgrid = .TRUE. ) 
     222               IF ( inpfiles(jj)%nvar < 2 ) THEN 
     223                  CALL ctl_stop( 'Feedback format error' ) 
     224                  RETURN 
     225               ENDIF 
     226               IF ( TRIM(inpfiles(jj)%cname(1)) /= 'POTM' ) THEN 
     227                  CALL ctl_stop( 'Feedback format error' ) 
     228                  RETURN 
     229               ENDIF 
     230               IF ( TRIM(inpfiles(jj)%cname(2)) /= 'PSAL' ) THEN 
     231                  CALL ctl_stop( 'Feedback format error' ) 
     232                  RETURN 
     233               ENDIF 
    234234               IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN 
    235235                  CALL ctl_stop( 'Model not in input data' ) 
    … …  
    295295            inowin = 0 
    296296            DO ji = 1, inpfiles(jj)%nobs 
     297               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
     298               IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
     299                  & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
    297300               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    298301                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    307310            inowin = 0 
    308311            DO ji = 1, inpfiles(jj)%nobs 
     312               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
     313               IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
     314                  & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
    309315               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    310316                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    319325            inowin = 0 
    320326            DO ji = 1, inpfiles(jj)%nobs 
     327               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
     328               IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
     329                  & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
    321330               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    322331                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    330339 
    331340            DO ji = 1, inpfiles(jj)%nobs 
     341               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
     342               IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
     343                  & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
    332344               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    333345                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    371383                     ENDIF 
    372384                  END DO loop_p_count 
     385 
    373386                  IF ( llvalprof ) iprof = iprof + 1 
     387 
    374388               ENDIF 
    375389            END DO 
    … …  
    389403      DO jj = 1, inobf 
    390404         DO ji = 1, inpfiles(jj)%nobs 
     405            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
     406            IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
     407               & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
    391408            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    392409               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    401418      DO jj = 1, inobf 
    402419         DO ji = 1, inpfiles(jj)%nobs 
     420            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
     421            IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
     422               & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
    403423            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    404424               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    408428               zdat(jk)     = inpfiles(jj)%ptim(ji) 
    409429            ENDIF 
    410          ENDDO 
    411       ENDDO 
     430         END DO 
     431      END DO 
    412432      CALL sort_dp_indx( iproftot, & 
    413433         &               zdat,     & 
    … …  
    446466         jj = ifileidx(iindx(jk)) 
    447467         ji = iprofidx(iindx(jk)) 
     468 
     469         IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
     470         IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
     471            & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     472 
    448473         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  & 
    449474            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN 
    … …  
    456481             
    457482            llvalprof = .FALSE. 
     483 
     484            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
     485 
     486            IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
     487               & ( inpfiles(jj)%ivqc(ji,2) > 2 ) ) CYCLE 
    458488 
    459489            loop_prof : DO ij = 1, inpfiles(jj)%nlev 
    … …  
    711741                  & ityptmpp(ji+1) 
    712742            ENDIF 
    713          ENDDO 
     743         END DO 
    714744         WRITE(numout,'(1X,A)') & 
    715745            & '---------------------------------------------------------------' 
    … …  
    728758                  & itypsmpp(ji+1) 
    729759            ENDIF 
    730          ENDDO 
     760         END DO 
    731761         WRITE(numout,'(1X,A)') & 
    732762            & '---------------------------------------------------------------' 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_read_seaice.F90

    r2001 r2074  
    5757 
    5858      !! * Arguments 
    59       INTEGER :: & 
    60          & kformat        ! Format of input data  
    61       !                   ! 0: Feedback 
    62       !                   ! 1: GHRSST 
     59      INTEGER :: kformat   ! Format of input data  
     60      !                    ! 0: Feedback 
     61      !                    ! 1: GHRSST 
    6362      TYPE(obs_surf), INTENT(INOUT) :: & 
    6463         & seaicedata     ! seaice data to be read 
    65       INTEGER, INTENT(IN) :: & 
    66          & knumfiles      ! Number of corio format files to read in 
    67       CHARACTER(LEN=128), INTENT(IN) ::  & 
    68          & cfilenames(knumfiles) ! File names to read in 
    69       INTEGER, INTENT(IN) ::  & 
    70          & kvars,  &      ! Number of variables in seaicedata 
    71          & kextr,  &      ! Number of extra fields for each var in seaicedata 
    72          & kstp           ! Ocean time-step index 
    73       LOGICAL, INTENT(IN) :: & 
    74          & ldignmis, &    ! Ignore missing files 
    75          & ldmod          ! Initialize model from input data 
    76       REAL(KIND=dp), INTENT(IN) ::  & 
    77          & ddobsini, &    ! Obs. ini time in YYYYMMDD.HHMMSS 
    78          & ddobsend       ! Obs. end time in YYYYMMDD.HHMMSS 
     64      INTEGER, INTENT(IN) :: knumfiles   ! Number of corio format files to read in 
     65      CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in 
     66      INTEGER, INTENT(IN) :: kvars    ! Number of variables in seaicedata 
     67      INTEGER, INTENT(IN) :: kextr    ! Number of extra fields for each var in seaicedata 
     68      INTEGER, INTENT(IN) :: kstp     ! Ocean time-step index 
     69      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files 
     70      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data 
     71      REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS 
     72      REAL(KIND=dp), INTENT(IN) :: ddobsend    ! Obs. end time in YYYYMMDD.HHMMSS 
    7973          
    8074      !! * Local declarations 
    8175      CHARACTER(LEN=14), PARAMETER :: cpname='obs_rea_seaice' 
    82       INTEGER :: & 
    83          & ji, & 
    84          & jj, & 
    85          & jk 
    86       INTEGER :: & 
    87          & iflag,     & 
    88          & inobf,     & 
    89          & i_file_id, & 
    90          & inowin,    & 
    91          & iyea,      & 
    92          & imon,      & 
    93          & iday,      & 
    94          & ihou,      & 
    95          & imin,      & 
    96          & isec 
     76      INTEGER :: ji 
     77      INTEGER :: jj 
     78      INTEGER :: jk 
     79      INTEGER :: iflag 
     80      INTEGER :: inobf 
     81      INTEGER :: i_file_id 
     82      INTEGER :: inowin 
     83      INTEGER :: iyea 
     84      INTEGER :: imon 
     85      INTEGER :: iday 
     86      INTEGER :: ihou 
     87      INTEGER :: imin 
     88      INTEGER :: isec 
    9789      INTEGER, DIMENSION(knumfiles) :: & 
    9890         & irefdate 
    99       INTEGER :: & 
    100          & iobsmpp 
    101       INTEGER, PARAMETER :: & 
    102          & iseaicemaxtype = 1024 
     91      INTEGER :: iobsmpp 
     92      INTEGER, PARAMETER :: iseaicemaxtype = 1024 
    10393      INTEGER, DIMENSION(0:iseaicemaxtype) :: & 
    10494         & ityp, & 
    … …  
    117107      REAL(dp), DIMENSION(:), ALLOCATABLE :: & 
    118108         & zdat 
    119       LOGICAL :: & 
    120          & llvalprof 
     109      LOGICAL :: llvalprof 
    121110      TYPE(obfbdata), POINTER, DIMENSION(:) :: & 
    122111         & inpfiles 
    … …  
    124113         & djulini, & 
    125114         & djulend 
    126       INTEGER :: & 
    127          & iobs, & 
    128          & iobstot 
    129      CHARACTER(len=8) :: & 
    130          & cl_refdate 
     115      INTEGER :: iobs 
     116      INTEGER :: iobstot 
     117      CHARACTER(len=8) :: cl_refdate 
    131118    
    132119      ! Local initialization 
    … …  
    438425               WRITE(numout,'(1X,A4,I4,A3,I10)')'Type ', jj,' = ',itypmpp(jj) 
    439426            ENDIF 
    440          ENDDO 
     427         END DO 
    441428         WRITE(numout,'(1X,A50)')'--------------------------------------------------' 
    442429         WRITE(numout,'(1X,A40,I10)')'Total                                 = ',iobsmpp 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_read_sla.F90

    r2001 r2074  
    3737      &                    sladata, knumfiles, cfilenames, & 
    3838      &                    kvars, kextr, kstp, ddobsini, ddobsend, & 
    39       &                    ldignmis, ldmod ) 
     39      &                    ldignmis, ldmod, ldobstd ) 
    4040      !!--------------------------------------------------------------------- 
    4141      !! 
    … …  
    5656 
    5757      !! * Arguments 
    58       INTEGER :: & 
    59          & kformat        ! Format of input data 
    60       !                   ! 0: Feedback 
    61       !                   ! 1: AVISO 
    62       TYPE(obs_surf), INTENT(INOUT) :: & 
    63          & sladata        ! SLA data to be read 
    64       INTEGER, INTENT(IN) :: & 
    65          & knumfiles      ! Number of files to read in 
     58      INTEGER :: kformat    ! Format of input data 
     59      !                     ! 0: Feedback 
     60      !                     ! 1: AVISO 
     61      TYPE(obs_surf), INTENT(INOUT) :: sladata    ! SLA data to be read 
     62      INTEGER, INTENT(IN) :: knumfiles      ! Number of files to read in 
    6663      CHARACTER(LEN=128), INTENT(IN) ::  & 
    6764         & cfilenames(knumfiles) ! File names to read in 
    68       INTEGER, INTENT(IN) ::  & 
    69          & kvars,  &      ! Number of variables in sladata 
    70          & kextr,  &      ! Number of extra fields for each var in sladata 
    71          & kstp           ! Ocean time-step index 
    72       LOGICAL, INTENT(IN) :: & 
    73          & ldignmis, &    ! Ignore missing files 
    74          & ldmod          ! Initialize model from input data 
    75       REAL(KIND=dp), INTENT(IN) ::  & 
    76          & ddobsini, &    ! Obs. ini time in YYYYMMDD.HHMMSS 
    77          & ddobsend       ! Obs. end time in YYYYMMDD.HHMMSS 
     65      INTEGER, INTENT(IN) :: kvars     ! Number of variables in sladata 
     66      INTEGER, INTENT(IN) :: kextr     ! Number of extra fields for each var in sladata 
     67      INTEGER, INTENT(IN) :: kstp      ! Ocean time-step index 
     68      LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files 
     69      LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data 
     70      LOGICAL, INTENT(INOUT), optional :: & 
     71         & ldobstd        ! Read observation standard deviation from fb. file 
     72      REAL(KIND=dp), INTENT(IN) :: ddobsini  ! Obs. ini time in YYYYMMDD.HHMMSS 
     73      REAL(KIND=dp), INTENT(IN) :: ddobsend  ! Obs. end time in YYYYMMDD.HHMMSS 
    7874          
    7975      !! * Local declarations 
    8076      CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_sla' 
    81       INTEGER :: & 
    82          & ji, & 
    83          & jj, & 
    84          & jk 
    85       INTEGER :: & 
    86          & iflag,     & 
    87          & inobf,     & 
    88          & i_file_id, & 
    89          & inowin,    & 
    90          & iyea,      & 
    91          & imon,      & 
    92          & iday,      & 
    93          & ihou,      & 
    94          & imin,      & 
    95          & isec 
     77      INTEGER :: ji 
     78      INTEGER :: jj 
     79      INTEGER :: jk 
     80      INTEGER :: iflag 
     81      INTEGER :: inobf 
     82      INTEGER :: i_file_id 
     83      INTEGER :: inowin 
     84      INTEGER :: iyea 
     85      INTEGER :: imon 
     86      INTEGER :: iday 
     87      INTEGER :: ihou 
     88      INTEGER :: imin 
     89      INTEGER :: isec 
    9690      INTEGER, DIMENSION(knumfiles) :: & 
    9791         & irefdate 
    98       INTEGER :: & 
    99          & iobsmpp 
     92      INTEGER :: iobsmpp 
    10093      INTEGER, DIMENSION(imaxmissions+1) :: & 
    10194         & ityp, & 
    … …  
    108101         & ifileidx, & 
    109102         & islaidx 
    110       INTEGER :: itype 
     103      INTEGER :: itype  
    111104      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    112105         & zphi, & 
    … …  
    114107      REAL(dp), DIMENSION(:), ALLOCATABLE :: & 
    115108         & zdat 
    116       LOGICAL :: & 
    117          & llvalprof 
     109      LOGICAL :: llvalprof 
     110      LOGICAL :: llobstd 
    118111      TYPE(obfbdata), POINTER, DIMENSION(:) :: & 
    119112         & inpfiles 
    … …  
    121114         & djulini, & 
    122115         & djulend 
    123       INTEGER :: & 
    124          & iobs, & 
    125          & iobstot 
    126      CHARACTER(len=8) :: & 
    127          & cl_refdate 
     116      INTEGER, DIMENSION(knumfiles) :: & 
     117         & iobspos, & 
     118         & iobcpos 
     119      INTEGER :: iobs 
     120      INTEGER :: iobstot 
     121      CHARACTER(len=8) :: cl_refdate 
    128122    
    129123      ! Local initialization 
    130124      iobs = 0 
     125      IF ( PRESENT(ldobstd) ) THEN 
     126         IF (.NOT.ldmod) THEN 
     127            llobstd = .false. 
     128         ELSE 
     129            llobstd = ldobstd 
     130         ENDIF 
     131      ELSE 
     132         llobstd = .FALSE. 
     133      ENDIF 
    131134  
    132135      !----------------------------------------------------------------------- 
    133       ! Check data the model part is just with feedback data files 
     136      ! Check that the model part is just with feedback data files 
    134137      !----------------------------------------------------------------------- 
    135138      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN 
    136139         CALL ctl_stop( 'Model can only be read from feedback data' ) 
     140         RETURN 
     141      ENDIF 
     142 
     143      !----------------------------------------------------------------------- 
     144      ! Check that the prescribed obs err is just with feedback data files 
     145      !----------------------------------------------------------------------- 
     146      IF ( llobstd .AND. ( kformat /= 0 ) ) THEN 
     147         CALL ctl_stop( 'Observation error can only be read from feedback files' ) 
    137148         RETURN 
    138149      ENDIF 
    … …  
    197208               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), & 
    198209                  &                ldgrid = .TRUE. ) 
     210               IF ( inpfiles(jj)%nvar < 1 ) THEN 
     211                  CALL ctl_stop( 'Feedback format error' ) 
     212                  RETURN 
     213               ENDIF 
     214               IF ( TRIM(inpfiles(jj)%cname(1)) /= 'SLA' ) THEN 
     215                  CALL ctl_stop( 'Feedback format error' ) 
     216                  RETURN 
     217               ENDIF  
    199218               IF ( ldmod .AND. ( ( inpfiles(jj)%nadd == 0 ) .OR.& 
    200                   &               ( inpfiles(jj)%next < 2 ) ) ) THEN 
     219                  &               ( inpfiles(jj)%next == 0 ) ) ) THEN 
    201220                  CALL ctl_stop( 'Model not in input data' ) 
    202221                  RETURN 
    … …  
    242261            inowin = 0 
    243262            DO ji = 1, inpfiles(jj)%nobs 
     263               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
     264               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 
    244265               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    245266                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    254275            inowin = 0 
    255276            DO ji = 1, inpfiles(jj)%nobs 
     277               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
     278               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 
    256279               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    257280                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    266289            inowin = 0 
    267290            DO ji = 1, inpfiles(jj)%nobs 
     291               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
     292               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 
    268293               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    269294                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    277302 
    278303            DO ji = 1, inpfiles(jj)%nobs 
     304               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
     305               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 
    279306               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    280307                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    293320 
    294321         ENDIF 
    295  
     322       
    296323      END DO sla_files 
    297324 
     325      IF (llobstd) THEN 
     326          
     327         DO jj = 1, inobf 
     328            iobspos(jj) = -1 
     329            iobcpos(jj) = -1 
     330            DO ji = 1,inpfiles(jj)%nadd 
     331               IF ( TRIM(inpfiles(jj)%caddname(ji)) == 'OSTD' ) THEN 
     332                  iobspos(jj)=ji 
     333               ENDIF 
     334               IF ( TRIM(inpfiles(jj)%caddname(ji)) == 'OCNT' ) THEN 
     335                  iobcpos(jj)=ji 
     336               ENDIF 
     337            END DO 
     338         END DO 
     339         llobstd = ( ( MINVAL(iobspos) > 0 ) .AND. ( MINVAL(iobcpos) > 0 ) ) 
     340         IF (llobstd) THEN 
     341            IF (lwp) WRITE(numout,*)'SLA superobs information present.' 
     342         ELSE 
     343            IF (lwp) WRITE(numout,*)'SLA superobs information not present.' 
     344         ENDIF 
     345 
     346      ENDIF 
     347       
    298348      !----------------------------------------------------------------------- 
    299349      ! Get the time ordered indices of the input data 
    … …  
    306356      DO jj = 1, inobf 
    307357         DO ji = 1, inpfiles(jj)%nobs 
     358            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
     359            IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 
    308360            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    309361               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    318370      DO jj = 1, inobf 
    319371         DO ji = 1, inpfiles(jj)%nobs 
     372            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
     373            IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 
    320374            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    321375               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    344398         jj = ifileidx(iindx(jk)) 
    345399         ji = islaidx(iindx(jk)) 
     400 
     401         IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
     402         IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 
     403 
    346404         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  & 
    347405            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN 
    … …  
    390448               ityp(itype+1) = ityp(itype+1) + 1 
    391449 
     450               ! Identifier 
     451               sladata%cwmo(iobs) = inpfiles(jj)%cdwmo(ji) 
     452 
    392453               ! Bookkeeping data to match observations 
    393454               sladata%nsidx(iobs) = iobs 
    … …  
    404465               IF ( ldmod ) THEN 
    405466                  sladata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1) 
    406                   sladata%rext(iobs,1:2) = inpfiles(jj)%pext(1,ji,1:2) 
     467                  sladata%rext(iobs,1) = inpfiles(jj)%padd(1,ji,2,1) 
     468                  sladata%rext(iobs,2) = inpfiles(jj)%pext(1,ji,1) 
     469                  IF (llobstd) THEN 
     470                     sladata%rext(iobs,3) = & 
     471                        & inpfiles(jj)%padd(1,ji,iobspos(jj),1) 
     472                     sladata%rext(iobs,4) = & 
     473                        & inpfiles(jj)%padd(1,ji,iobcpos(jj),1) 
     474                  ENDIF 
    407475               ELSE 
    408476                  sladata%rmod(iobs,1) = fbrmdi 
    409477                  sladata%rext(iobs,:) = fbrmdi 
    410478               ENDIF 
     479 
    411480            ENDIF 
    412481         ENDIF 
    … …  
    433502               WRITE(numout,'(1X,A38,A2,I10)')calttyp(jj-1),'= ',itypmpp(jj) 
    434503            ENDIF 
    435          ENDDO 
     504         END DO 
    436505         WRITE(numout,'(1X,A50)')'--------------------------------------------------' 
    437506         WRITE(numout,'(1X,A40,I10)')'Total                                 = ',iobsmpp 
    … …  
    453522      DEALLOCATE( inpfiles ) 
    454523 
     524      !----------------------------------------------------------------------- 
     525      ! Reset ldobstd if the data is present 
     526      !----------------------------------------------------------------------- 
     527      IF ( PRESENT(ldobstd) ) THEN 
     528         ldobstd = llobstd 
     529      ENDIF 
     530 
    455531   END SUBROUTINE obs_rea_sla 
    456532 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_read_sst.F90

    r2001 r2074  
    5858 
    5959      !! * Arguments 
    60       INTEGER :: & 
    61          & kformat        ! Format of input data 
    62       !                   ! 0: Feedback 
    63       !                   ! 1: GHRSST 
    64       TYPE(obs_surf), INTENT(INOUT) :: & 
    65          & sstdata        ! SST data to be read 
    66       INTEGER, INTENT(IN) :: & 
    67          & knumfiles      ! Number of corio format files to read in 
    68       CHARACTER(LEN=128), INTENT(IN) ::  & 
    69          & cfilenames(knumfiles) ! File names to read in 
    70       INTEGER, INTENT(IN) ::  & 
    71          & kvars,  &      ! Number of variables in sstdata 
    72          & kextr,  &      ! Number of extra fields for each var in sstdata 
    73          & kstp           ! Ocean time-step index 
    74       LOGICAL, INTENT(IN) :: & 
    75          & ldignmis, &    ! Ignore missing files 
    76          & ldmod          ! Initialize model from input data 
    77       REAL(KIND=dp), INTENT(IN) ::  & 
    78          & ddobsini, &    ! Obs. ini time in YYYYMMDD.HHMMSS 
    79          & ddobsend       ! Obs. end time in YYYYMMDD.HHMMSS 
     60      INTEGER :: kformat   ! Format of input data 
     61      !                    ! 0: Feedback 
     62      !                    ! 1: GHRSST 
     63      TYPE(obs_surf), INTENT(INOUT) :: sstdata   ! SST data to be read 
     64      INTEGER, INTENT(IN) :: knumfiles    ! Number of corio format files to read in 
     65      CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in 
     66      INTEGER, INTENT(IN) :: kvars      ! Number of variables in sstdata 
     67      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var in sstdata 
     68      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index 
     69      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files 
     70      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data 
     71      REAL(KIND=dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS 
     72      REAL(KIND=dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS 
    8073          
    8174      !! * Local declarations 
    8275      CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_sst' 
    83       INTEGER :: & 
    84          & ji, & 
    85          & jj, & 
    86          & jk 
    87       INTEGER :: & 
    88          & iflag,     & 
    89          & inobf,     & 
    90          & i_file_id, & 
    91          & inowin,    & 
    92          & iyea,      & 
    93          & imon,      & 
    94          & iday,      & 
    95          & ihou,      & 
    96          & imin,      & 
    97          & isec 
    98       INTEGER, DIMENSION(knumfiles) :: & 
    99          & irefdate 
    100       INTEGER :: & 
    101          & iobsmpp 
    102       INTEGER, PARAMETER :: & 
    103          & isstmaxtype = 1024 
     76      INTEGER :: ji 
     77      INTEGER :: jj 
     78      INTEGER :: jk 
     79      INTEGER :: iflag 
     80      INTEGER :: inobf 
     81      INTEGER :: i_file_id 
     82      INTEGER :: inowin 
     83      INTEGER :: iyea 
     84      INTEGER :: imon 
     85      INTEGER :: iday 
     86      INTEGER :: ihou 
     87      INTEGER :: imin 
     88      INTEGER :: isec 
     89      INTEGER, DIMENSION(knumfiles) :: irefdate 
     90      INTEGER :: iobsmpp 
     91      INTEGER, PARAMETER :: isstmaxtype = 1024 
    10492      INTEGER, DIMENSION(0:isstmaxtype) :: & 
    10593         & ityp, & 
    … …  
    118106      REAL(dp), DIMENSION(:), ALLOCATABLE :: & 
    119107         & zdat 
    120       LOGICAL :: & 
    121          & llvalprof 
     108      LOGICAL :: llvalprof 
    122109      TYPE(obfbdata), POINTER, DIMENSION(:) :: & 
    123110         & inpfiles 
    … …  
    125112         & djulini, & 
    126113         & djulend 
    127       INTEGER :: & 
    128          & iobs, & 
    129          & iobstot 
    130      CHARACTER(len=8) :: & 
    131          & cl_refdate 
     114      INTEGER :: iobs 
     115      INTEGER :: iobstot 
     116      CHARACTER(len=8) :: cl_refdate 
    132117    
    133118      ! Local initialization 
    … …  
    439424               WRITE(numout,'(1X,A4,I4,A3,I10)')'Type ', jj,' = ',itypmpp(jj) 
    440425            ENDIF 
    441          ENDDO 
     426         END DO 
    442427         WRITE(numout,'(1X,A50)')'--------------------------------------------------' 
    443428         WRITE(numout,'(1X,A40,I10)')'Total                                 = ',iobsmpp 
    … …  
    484469    
    485470      !! * Arguments 
    486       CHARACTER(len=128), INTENT(IN) :: & 
    487          & sstname         ! Generic file name 
    488       CHARACTER(len=12), INTENT(IN) :: & 
    489          & cdsstfmt        ! Format of SST files (yearly/monthly) 
    490       TYPE(obs_surf), INTENT(INOUT) :: & 
    491          & sstdata         ! SST data 
    492       REAL(KIND=dp), INTENT(IN) ::  & 
    493          &  ddobsini, &    ! Obs. ini time in YYYYMMDD.HHMMSS 
    494          &  ddobsend       ! Obs. end time in YYYYMMDD.HHMMSS 
    495       INTEGER, INTENT(IN) :: & 
    496          &  kvars,  &      ! Number of variables in sstdata structures 
    497          &  kextra, &      ! Number of extra variables in sstdata structures 
    498          &  kstp           ! Ocean time-step index 
    499        
    500       INTEGER :: & 
    501          & iyear,   & 
    502          & imon,    & 
    503          & iday,    & 
    504          & ihour,   & 
    505          & imin,    & 
    506          & isec,    & 
    507          & ihhmmss, & 
    508          & iyear1,  & 
    509          & iyear2,  & 
    510          & imon1,   & 
    511          & imon2,   & 
    512          & iyearf,  & 
    513          & imonf 
    514       REAL(KIND=wp) :: & 
    515          & pjulini, & 
    516          & pjulend, & 
    517          & pjulb, & 
    518          & pjule, & 
    519          & pjul 
    520       INTEGER :: & 
    521          & inumsst, & 
    522          & itotrec, & 
    523          & inumobs, & 
    524          & irec, & 
    525          & ifld, & 
    526          & inum 
    527       INTEGER :: & 
    528          & ji, jj 
    529       CHARACTER(len=128) :: & 
    530          & clname 
    531       CHARACTER(len=4) :: & 
    532          & cdyear 
    533       CHARACTER(len=2) :: & 
    534          & cdmon 
    535       REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:) :: & 
    536          & zsstin 
     471      CHARACTER(len=128), INTENT(IN) :: sstname   ! Generic file name 
     472      CHARACTER(len=12), INTENT(IN) :: cdsstfmt   ! Format of SST files (yearly/monthly) 
     473      TYPE(obs_surf), INTENT(INOUT) :: sstdata    ! SST data 
     474      REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS 
     475      REAL(KIND=dp), INTENT(IN) :: ddobsend    ! Obs. end time in YYYYMMDD.HHMMSS 
     476      INTEGER, INTENT(IN) :: kvars      ! Number of variables in sstdata structures 
     477      INTEGER, INTENT(IN) :: kextra     ! Number of extra variables in sstdata structures 
     478      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index 
     479       
     480      INTEGER :: iyear 
     481      INTEGER :: imon 
     482      INTEGER :: iday 
     483      INTEGER :: ihour 
     484      INTEGER :: imin 
     485      INTEGER :: isec 
     486      INTEGER :: ihhmmss 
     487      INTEGER :: iyear1 
     488      INTEGER :: iyear2 
     489      INTEGER :: imon1 
     490      INTEGER :: imon2 
     491      INTEGER :: iyearf 
     492      INTEGER :: imonf 
     493      REAL(KIND=wp) :: pjulini 
     494      REAL(KIND=wp) :: pjulend 
     495      REAL(KIND=wp) :: pjulb 
     496      REAL(KIND=wp) :: pjule 
     497      REAL(KIND=wp) :: pjul 
     498      INTEGER :: inumsst 
     499      INTEGER :: itotrec 
     500      INTEGER :: inumobs 
     501      INTEGER :: irec 
     502      INTEGER :: ifld 
     503      INTEGER :: inum 
     504      INTEGER :: ji, jj 
     505      CHARACTER(len=128) :: clname 
     506      CHARACTER(len=4) :: cdyear 
     507      CHARACTER(len=2) :: cdmon 
     508      REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:) :: zsstin 
    537509 
    538510      IF (lwp) WRITE(numout,*)'In obs_rea_sst_rey',sstname 
    … …  
    588560                  CALL iom_close ( inumsst )       
    589561                   
    590                END IF 
     562               ENDIF 
    591563                
    592564               clname = sstname 
    … …  
    646618                  CALL iom_close ( inumsst )       
    647619                   
    648                END IF 
     620               ENDIF 
    649621                
    650622               clname = sstname 
    … …  
    717689         DO ji = nldi, nlei 
    718690            IF ( tmask(ji,jj,1) == 1.0_wp ) inumobs = inumobs + 1 
    719          ENDDO 
    720       ENDDO 
     691         END DO 
     692      END DO 
    721693      inumobs = inumobs * itotrec 
    722694 
    … …  
    771743               ENDIF 
    772744 
    773             ENDDO 
    774          ENDDO 
     745            END DO 
     746         END DO 
    775747 
    776748         pjul = pjul + 1 
    … …  
    778750         IF ( pjul > pjulend ) EXIT 
    779751 
    780       ENDDO 
     752      END DO 
    781753 
    782754   END SUBROUTINE obs_rea_sst_rey 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_read_vel.F90

    r2001 r2074  
    5959    
    6060      !! * Arguments 
    61       INTEGER :: & 
    62          & kformat        ! Format of input data 
    63       !                   ! 1: ENACT 
    64       !                   ! 2: Coriolis 
    65       TYPE(obs_prof), INTENT(OUT) :: & 
    66          & profdata       ! Profile data to be read 
    67       INTEGER, INTENT(IN) :: & 
    68          & knumfiles      ! Number of files to read in 
    69       CHARACTER(LEN=128), INTENT(IN) ::  & 
    70          & cfilenames(knumfiles) ! File names to read in 
    71       INTEGER, INTENT(IN) ::  & 
    72          & kvars,  &      ! Number of variables in profdata 
    73          & kextr,  &      ! Number of extra fields for each var in profdata 
    74          & kstp           ! Ocean time-step index 
    75       LOGICAL, INTENT(IN) :: & 
    76          & ldignmis, &    ! Ignore missing files 
    77          & ldavtimset, &  ! Set time to be equal to the end of the day 
    78          & ldmod          ! Initialize model from input data 
    79       REAL(KIND=dp), INTENT(IN) ::  & 
    80          & ddobsini, &    ! Obs. ini time in YYYYMMDD.HHMMSS 
    81          & ddobsend       ! Obs. end time in YYYYMMDD.HHMMSS 
     61      INTEGER :: kformat   ! Format of input data 
     62      !                    ! 1: ENACT 
     63      !                    ! 2: Coriolis 
     64      TYPE(obs_prof), INTENT(OUT) :: profdata    ! Profile data to be read 
     65      INTEGER, INTENT(IN) :: knumfiles           ! Number of files to read in 
     66      CHARACTER(LEN=128), INTENT(IN) ::  cfilenames(knumfiles) ! File names to read in 
     67      INTEGER, INTENT(IN) :: kvars       ! Number of variables in profdata 
     68      INTEGER, INTENT(IN) :: kextr       ! Number of extra fields for each var in profdata 
     69      INTEGER, INTENT(IN) :: kstp        !  Ocean time-step index 
     70      LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files 
     71      LOGICAL, INTENT(IN) :: ldavtimset  ! Set time to be equal to the end of the day 
     72      LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data 
     73      REAL(KIND=dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS 
     74      REAL(KIND=dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS 
    8275 
    8376      !! * Local declarations 
    8477      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_vel_dri' 
    85       INTEGER :: & 
    86          & jvar, & 
    87          & ji,   & 
    88          & jj,   &  
    89          & jk 
    90       INTEGER :: & 
    91          & ij,        & 
    92          & iflag,     & 
    93          & inobf,     & 
    94          & i_file_id, & 
    95          & inowin,    & 
    96          & iyea,      & 
    97          & imon,      & 
    98          & iday,      & 
    99          & ihou,      & 
    100          & imin,      & 
    101          & isec 
     78      INTEGER :: jvar 
     79      INTEGER :: ji 
     80      INTEGER :: jj 
     81      INTEGER :: jk 
     82      INTEGER :: ij 
     83      INTEGER :: iflag 
     84      INTEGER :: inobf 
     85      INTEGER :: i_file_id 
     86      INTEGER :: inowin 
     87      INTEGER :: iyea 
     88      INTEGER :: imon 
     89      INTEGER :: iday 
     90      INTEGER :: ihou 
     91      INTEGER :: imin 
     92      INTEGER :: isec 
    10293      INTEGER, DIMENSION(knumfiles) :: & 
    10394         & irefdate 
    … …  
    10596         & itypuv,    & 
    10697         & itypuvmpp  
    107       INTEGER :: & 
    108          & iuv3dtmpp 
     98      INTEGER :: iuv3dtmpp 
    10999      INTEGER, DIMENSION(:), ALLOCATABLE :: & 
    110100         & iobsiu,   & 
    … …  
    130120         & djulini, & 
    131121         & djulend 
    132       INTEGER :: & 
    133          & iprof,    & 
    134          & iproftot, & 
    135          & iuv3dt 
    136       INTEGER, DIMENSION(kvars) :: & 
    137          & iv3dt 
    138       CHARACTER(len=8) :: & 
    139          & cl_refdate 
     122      INTEGER :: iprof 
     123      INTEGER :: iproftot 
     124      INTEGER :: iuv3dt 
     125      INTEGER, DIMENSION(kvars) :: iv3dt 
     126      CHARACTER(len=8) :: cl_refdate 
    140127    
    141128      ! Local initialization 
    … …  
    375362               zdat(jk)     = inpfiles(jj)%ptim(ji) 
    376363            ENDIF 
    377          ENDDO 
    378       ENDDO 
     364         END DO 
     365      END DO 
    379366      CALL sort_dp_indx( iproftot, & 
    380367         &               zdat,     & 
    … …  
    603590                  & itypuvmpp(ji+1) 
    604591            ENDIF 
    605          ENDDO 
     592         END DO 
    606593         WRITE(numout,'(1X,A)') '--------------' 
    607594         WRITE(numout,'(1X,A6,I8)') & 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_readmdt.F90

    r2001 r2074  
    4747   PRIVATE 
    4848 
    49    INTEGER, PUBLIC :: & 
    50       & nmsshc = 1        ! MDT correction scheme 
    51    REAL(wp), PUBLIC :: & 
    52       & mdtcorr = 1.61    ! User specified MDT correction 
    53    REAL(wp), PUBLIC :: & 
    54       & mdtcutoff = 65.0  ! MDT cutoff for computed correction 
     49   INTEGER, PUBLIC :: nmsshc = 1        ! MDT correction scheme 
     50   REAL(wp), PUBLIC :: mdtcorr = 1.61   ! User specified MDT correction 
     51   REAL(wp), PUBLIC :: mdtcutoff = 65.0  ! MDT cutoff for computed correction 
    5552   PUBLIC obs_rea_mdt     ! Read the MDT 
    5653   PUBLIC obs_offset_mdt  ! Remove the offset between the model MDT and the  
    … …  
    8077 
    8178      !! * Arguments 
    82       INTEGER, INTENT(IN) :: & 
    83          & kslano          ! Number of SLA Products 
     79      INTEGER, INTENT(IN) :: kslano          ! Number of SLA Products 
    8480      TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: & 
    8581         & sladata       ! SLA data 
    86       INTEGER, INTENT(IN) :: & 
    87          & k2dint 
     82      INTEGER, INTENT(IN) :: k2dint 
    8883 
    8984      !! * Local declarations 
    … …  
    9489         & mdtname = 'slaReferenceLevel.nc' 
    9590 
    96       INTEGER :: & 
    97          & jslano,  &      ! Data set loop variable 
    98          & jobs,    &      ! Obs loop variable 
    99          & jpimdt,  &      ! Number of grid point in latitude for the MDT 
    100          & jpjmdt,  &      ! Number of grid point in longitude for the MDT 
    101          & iico,    &      ! Grid point indicies 
    102          & ijco 
    103       INTEGER :: &  
    104          & i_nx_id,     &  ! Index to read the NetCDF file 
    105          & i_ny_id,     &  !  
    106          & i_file_id,   &  !  
    107          & i_var_id,    & 
    108          & i_stat 
     91      INTEGER :: jslano      ! Data set loop variable 
     92      INTEGER :: jobs        ! Obs loop variable 
     93      INTEGER :: jpimdt      ! Number of grid point in latitude for the MDT 
     94      INTEGER :: jpjmdt      ! Number of grid point in longitude for the MDT 
     95      INTEGER :: iico        ! Grid point indicies 
     96      INTEGER :: ijco  
     97      INTEGER :: i_nx_id     ! Index to read the NetCDF file 
     98      INTEGER :: i_ny_id     !  
     99      INTEGER :: i_file_id   !  
     100      INTEGER :: i_var_id 
     101      INTEGER :: i_stat 
    109102 
    110103      REAL(wp), DIMENSION(jpi,jpj) :: &  
    111          & z_mdt           ! Array to store the MDT values 
     104         & z_mdt,       &  ! Array to store the MDT values 
     105         & mdtmask         ! Array to store the mask for the MDT 
    112106      REAL(wp), DIMENSION(1) :: & 
    113107         & zext, & 
    … …  
    120114         & zglam, & 
    121115         & zgphi 
    122       REAL(wp) :: & 
    123          & zlam, & 
    124          & zphi, & 
    125          & zfill 
     116          
     117      REAL(wp) :: zlam 
     118      REAL(wp) :: zphi 
     119      REAL(wp) :: zfill 
    126120      REAL(sp) :: zinfill 
    127121      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
    128122         & igrdi, & 
    129123         & igrdj 
    130       INTEGER :: & 
    131          & nummdt 
     124      INTEGER :: nummdt 
    132125 
    133126      IF(lwp)WRITE(numout,*)  
    … …  
    156149      zfill = zinfill 
    157150      i_stat = nf90_close( nummdt ) 
     151 
     152! setup mask based on tmask and MDT mask 
     153! set mask to 0 where the MDT is set to fillvalue 
     154 
     155      WHERE(z_mdt(:,:) /= zfill) 
     156         mdtmask(:,:)=tmask(:,:,1) 
     157      ELSEWHERE 
     158         mdtmask(:,:)=0 
     159      END WHERE 
    158160 
    159161      ! Remove the offset between the MDT used with the sla and the model MDT 
    … …  
    192194            &                  igrdi, igrdj, gphit, zgphi ) 
    193195         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 
    194             &                  igrdi, igrdj, tmask(:,:,1), zmask ) 
     196            &                  igrdi, igrdj, mdtmask, zmask ) 
    195197         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 
    196198            &                  igrdi, igrdj, z_mdt, zmdtl ) 
    … …  
    200202            zlam = sladata(jslano)%rlam(jobs) 
    201203            zphi = sladata(jslano)%rphi(jobs) 
    202             iico = sladata(jslano)%mi(jobs) 
    203             ijco = sladata(jslano)%mj(jobs) 
    204              
     204 
    205205            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
    206206               &                   zglam(:,:,jobs), zgphi(:,:,jobs), & 
    207207               &                   zmask(:,:,jobs), zweig, zobsmask ) 
    208208             
    209  
    210             IF ( z_mdt(iico-1,ijco-1) == zfill .OR. & 
    211                  z_mdt(iico-1,ijco  ) == zfill .OR. & 
    212                  z_mdt(iico  ,ijco-1) == zfill .OR. & 
    213                  z_mdt(iico  ,ijco  ) == zfill ) THEN 
    214                 
    215           sladata(jslano)%rext(jobs,2) = obfillflt 
    216                sladata(jslano)%nqc(jobs)    = 11                ! set qc flag for data with no mdt    
    217        ELSE 
    218  
    219                 CALL obs_int_h2d( 1, 1,      & 
     209            CALL obs_int_h2d( 1, 1,      & 
    220210                   &              zweig, zmdtl(:,:,jobs),  zext ) 
    221              
    222                 sladata(jslano)%rext(jobs,2) = zext(1) 
    223  
    224             ENDIF 
     211  
     212            sladata(jslano)%rext(jobs,2) = zext(1) 
     213 
     214! mark any masked data with a QC flag 
     215            IF ( zobsmask(1) == 0 ) sladata(jslano)%nqc(jobs) = 11 
    225216 
    226217         END DO 
    … …  
    265256      REAL(wp), INTENT(IN) :: zfill  
    266257 
    267       !! * Local declarations 
    268       REAL(wp) :: &  
    269          & zdxdy,       &   
    270          & zarea,       &   
    271          & zeta1,       &   
    272          & zeta2,       &   
    273          & zcorr_mdt,   &   
    274          & zcorr_bcketa,& 
    275          & zcorr 
    276       REAL(wp), DIMENSION(jpi,jpj) :: & 
    277          & zpromsk 
    278       INTEGER :: & 
    279          & jj, & 
    280          & ji 
     258      !! * Local declarations  
     259      REAL(wp) :: zdxdy 
     260      REAL(wp) :: zarea 
     261      REAL(wp) :: zeta1 
     262      REAL(wp) :: zeta2 
     263      REAL(wp) :: zcorr_mdt   
     264      REAL(wp) :: zcorr_bcketa 
     265      REAL(wp) :: zcorr 
     266      REAL(wp), DIMENSION(jpi,jpj) :: zpromsk 
     267      INTEGER :: jj 
     268      INTEGER :: ji 
    281269      CHARACTER(LEN=14), PARAMETER :: & 
    282270         & cpname = 'obs_offset_mdt' 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_rot_vel.F90

    r2001 r2074  
    5151    
    5252      !! * Arguments 
    53       TYPE(obs_prof), INTENT(INOUT) :: & 
    54          & profdata       ! Profile data to be read 
    55       INTEGER, INTENT(IN) :: & 
    56          & k2dint         ! Horizontal interpolation methed 
     53      TYPE(obs_prof), INTENT(INOUT) :: profdata    ! Profile data to be read 
     54      INTEGER, INTENT(IN) :: k2dint     ! Horizontal interpolation methed 
    5755      REAL(wp), DIMENSION(*) :: & 
    5856         & pu, & 
    … …  
    6462         & zsingv, & 
    6563         & zcosgv 
    66       REAL(wp), DIMENSION(2,2,1) :: & 
    67          & zweig 
     64      REAL(wp), DIMENSION(2,2,1) :: zweig 
    6865      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    6966         & zmasku, & 
    … …  
    8279         & zsinv, & 
    8380         & zcosv 
    84       REAL(wp) :: & 
    85          & zsin, & 
    86          & zcos 
    87       REAL(wp), DIMENSION(1) :: & 
    88          & zobsmask 
     81      REAL(wp) :: zsin 
     82      REAL(wp) :: zcos 
     83      REAL(wp), DIMENSION(1) :: zobsmask 
    8984      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
    9085         & igrdiu, & 
    … …  
    9287         & igrdiv, & 
    9388         & igrdjv 
    94       INTEGER :: & 
    95          & ji, & 
    96          & jk 
     89      INTEGER :: ji 
     90      INTEGER :: jk 
    9791 
    9892      !----------------------------------------------------------------------- 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_seaice_io.h90

    r2001 r2074  
    2323      !! * Local declarations 
    2424      CHARACTER(LEN=12),PARAMETER :: cpname = 'read_seaice' 
    25       INTEGER :: & 
    26          & i_file_id, &     ! netcdf IDS 
    27          & i_time_id, & 
    28          & i_ni_id,   & 
    29          & i_data_id, & 
    30          & i_var_id 
    31       INTEGER ::  & 
    32          & i_data, &        ! Number of data per parameter in current file 
    33          & i_time           ! Number of reference times in file 
     25      INTEGER :: i_file_id    ! netcdf IDS 
     26      INTEGER :: i_time_id 
     27      INTEGER :: i_ni_id 
     28      INTEGER :: i_data_id 
     29      INTEGER :: i_var_id 
     30      INTEGER :: i_data       ! Number of data per parameter in current file 
     31      INTEGER :: i_time       ! Number of reference times in file 
    3432      INTEGER, DIMENSION(:), POINTER :: & 
    3533         & i_reftime        ! Reference time in file in seconds since 1/1/1981. 
    … …  
    4341      REAL(wp), DIMENSION(:,:), POINTER :: & 
    4442         & z_seaice         ! Seaice data      
    45       INTEGER, PARAMETER :: & 
    46          & imaxdim = 2      ! Assumed maximum for no. dims. in file 
    47       INTEGER, DIMENSION(2) :: & 
    48          & idims            ! Dimensions in file 
    49       INTEGER :: &                   
    50          & iilen, &         ! Length of netCDF attributes 
    51          & itype            ! Typeof netCDF attributes 
    52       REAL(KIND=wp) :: & 
    53          & zsca, &          ! Scale factor 
    54          & zoff, &          ! Offset for data in netcdf file 
    55          & z_offset, &      ! Offset for time conversion 
    56          & zfill            ! Fill value in netcdf file 
    57       CHARACTER (len=33) :: & 
    58          & creftime         ! Reference time of file 
    59       INTEGER :: & 
    60          & i_refyear,  &    ! Integer version of reference time 
    61          & i_refmonth, & 
    62          & i_refday,   & 
    63          & i_refhour,  & 
    64          & i_refmin,   & 
    65          & i_refsec 
    66       INTEGER :: & 
    67          & ichunk 
    68       integer :: & 
    69          & jtim, & 
    70          & jobs, & 
    71          & iobs 
     43      INTEGER, PARAMETER :: imaxdim = 2    ! Assumed maximum for no. dims. in file 
     44      INTEGER, DIMENSION(2) :: idims       ! Dimensions in file 
     45      INTEGER :: iilen          ! Length of netCDF attributes 
     46      INTEGER :: itype          ! Typeof netCDF attributes 
     47      REAL(KIND=wp) :: zsca      ! Scale factor 
     48      REAL(KIND=wp) :: zoff      ! Offset for data in netcdf file 
     49      REAL(KIND=wp) :: z_offset  ! Offset for time conversion 
     50      REAL(KIND=wp) :: zfill     ! Fill value in netcdf file 
     51      CHARACTER (len=33) ::creftime     ! Reference time of file 
     52      INTEGER :: i_refyear       ! Integer version of reference time 
     53      INTEGER :: i_refmonth 
     54      INTEGER :: i_refday 
     55      INTEGER :: i_refhour 
     56      INTEGER :: i_refmin 
     57      INTEGER :: i_refsec 
     58      INTEGER :: ichunk 
     59      INTEGER :: jtim 
     60      INTEGER :: jobs 
     61      INTEGER :: iobs 
    7262 
    7363      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, & 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_sla_io.h90

    r2001 r2074  
    2323      !! * Local declarations 
    2424      CHARACTER(LEN=14),PARAMETER :: cpname = 'read_avisofile' 
    25       INTEGER :: & 
    26          & i_file_id,   &   ! netcdf IDS 
    27          & i_tracks_id, & 
    28          & i_cycles_id, & 
    29          & i_data_id,   & 
    30          & i_var_id 
    31       INTEGER, PARAMETER :: & 
    32          & imaxdim = 2      ! Assumed maximum for no. dims. in file 
    33       INTEGER, DIMENSION(2) :: & 
    34          & idims            ! Dimensions in file 
    35       INTEGER :: &                   
    36          & iilen, &         ! Length of netCDF attributes 
    37          & itype            ! Typeof netCDF attributes 
    38       REAL(fbdp) :: & 
    39          & zsca, &          ! Scale factor 
    40          & zfill            ! Fill value 
    41       CHARACTER(len=3) :: & 
    42          & cmission         ! Mission global attribute 
    43       INTEGER ::  & 
    44          & itracks, &       ! Maximum number of passes in file 
    45          & icycles, &       ! Maximum number of cycles for each pass 
    46          & idata            ! Number of data per parameter in current file 
    47       REAL(fbdp) :: & 
    48          & zdeltat          ! Time gap getween two measurements in seconds 
     25      INTEGER :: i_file_id     ! netcdf IDS 
     26      INTEGER :: i_tracks_id 
     27      INTEGER :: i_cycles_id 
     28      INTEGER :: i_data_id 
     29      INTEGER :: i_var_id 
     30      INTEGER, PARAMETER :: imaxdim = 2    ! Assumed maximum for no. dims. in file 
     31      INTEGER, DIMENSION(2) :: idims       ! Dimensions in file 
     32      INTEGER :: iilen         ! Length of netCDF attributes 
     33      INTEGER :: itype         ! Typeof netCDF attributes 
     34      REAL(fbdp) :: zsca       ! Scale factor 
     35      REAL(fbdp) :: zfill      ! Fill value 
     36      CHARACTER(len=3) ::  cmission      ! Mission global attribute 
     37      INTEGER :: itracks       ! Maximum number of passes in file 
     38      INTEGER :: icycles       ! Maximum number of cycles for each pass 
     39      INTEGER :: idata         ! Number of data per parameter in current file 
     40      REAL(fbdp) :: zdeltat    ! Time gap getween two measurements in seconds 
    4941      INTEGER, DIMENSION(:), POINTER :: &  
    5042         & iptracks,     &  ! List of passes contained in current file 
    … …  
    5850      REAL(fbdp), DIMENSION(:,:), POINTER :: & 
    5951         & zbegindates      ! Date of point with index 0 
     52      REAL(fbdp) :: zbeginmiss    ! Missing data for dates 
    6053      REAL(fbsp), DIMENSION(:,:), POINTER :: & 
    6154         & zsla             ! SLA data 
    6255      REAL(fbdp), DIMENSION(:), POINTER :: & 
    6356         & zjuld            ! Julian date 
    64       CHARACTER(len=14) :: & 
    65          & cdjuldref        ! Julian data reference 
    66       INTEGER :: & 
    67          & imission         ! Mission number converted from Mission global  
     57      LOGICAL, DIMENSION(:), POINTER :: & 
     58         & llskip           ! Skip observation 
     59      CHARACTER(len=14) :: cdjuldref    ! Julian data reference 
     60      INTEGER :: imission   ! Mission number converted from Mission global  
    6861                            ! netCDF atttribute. 
    69       CHARACTER(len=255) :: & 
    70          & ctmp 
    71       INTEGER :: & 
    72          & iobs 
    73       INTEGER :: & 
    74          & jl, & 
    75          & jm, & 
    76          & jj, & 
    77          & ji, & 
    78          & jk, & 
    79          & jobs, & 
    80          & jcycle 
     62      CHARACTER(len=255) :: ctmp 
     63      INTEGER :: iobs 
     64      INTEGER :: jl 
     65      INTEGER :: jm 
     66      INTEGER :: jj 
     67      INTEGER :: ji 
     68      INTEGER :: jk 
     69      INTEGER :: jobs 
     70      INTEGER :: jcycle 
    8171 
    8272      ! Open the file 
    … …  
    116106         & ipdataindexes( idata            ), &  
    117107         & zsla         ( icycles, idata   ), & 
    118          & zjuld        ( idata*icycles    )  & 
     108         & zjuld        ( idata*icycles    ), & 
     109         & llskip       ( idata*icycles    )  & 
    119110         & ) 
    120111 
    … …  
    218209         ENDIF 
    219210         IF (jl>14) EXIT 
    220       ENDDO 
     211      END DO 
     212      CALL chkerr( nf90_inquire_attribute( i_file_id, i_var_id, '_FillValue', & 
     213         &                                  xtype = itype), cpname, __LINE__ ) 
     214      IF ( itype /= NF90_DOUBLE ) THEN 
     215         CALL fatal_error('Error decoding BeginDates missing data', __LINE__ ) 
     216      ENDIF 
     217      CALL chkerr( nf90_get_att( i_file_id, i_var_id, '_FillValue', & 
     218         &                       zbeginmiss ), cpname, __LINE__ ) 
    221219 
    222220      ! Get indices of data in theoretical profile 
    … …  
    275273            EXIT 
    276274         ENDIF 
    277       ENDDO 
     275      END DO 
    278276       
    279277      ! Close the file 
    … …  
    290288            DO jk = 1, icycles 
    291289               jm = jm + 1 
    292                zjuld(jm) = zbegindates(jk,jj) + & 
    293                   &        (ipdataindexes(jl) * zdeltat / 86400._wp ) 
     290               IF (zbegindates(jk,jj)==zbeginmiss) THEN 
     291                  llskip(jm) = .TRUE. 
     292                  zjuld(jm)  = fbrmdi 
     293               ELSE 
     294                  llskip(jm) = .FALSE. 
     295                  zjuld(jm)  = zbegindates(jk,jj) + & 
     296                     &         (ipdataindexes(jl) * zdeltat / 86400._wp ) 
     297               ENDIF 
    294298            END DO 
    295299         END DO 
    296300      END DO 
     301 
     302      ! Get rid of missing data 
     303 
     304      jm = 0 
     305      DO jobs = 1, idata 
     306         DO jcycle = 1, icycles 
     307            jm = jm + 1 
     308            IF (zsla(jcycle,jobs) == fbrmdi) llskip(jm) = .TRUE. 
     309         END DO 
     310      END DO 
    297311       
    298312      ! Allocate obfbdata 
    299        
    300       iobs = idata * icycles 
     313 
     314      iobs = COUNT( .NOT.llskip(:) ) 
    301315      CALL init_obfbdata( inpfile ) 
    302316      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid ) 
    … …  
    307321      inpfile%cdjuldref = cdjuldref 
    308322      iobs = 0 
     323      jm = 0 
    309324      DO jobs = 1, idata 
    310325         DO jcycle = 1, icycles 
     326            jm = jm + 1 
     327            IF (llskip(jm)) CYCLE 
    311328            iobs = iobs + 1 
    312329            ! Characters 
    … …  
    317334            inpfile%pphi(iobs)         = zphi(jobs) 
    318335            inpfile%pob(1,iobs,1)      = zsla(jcycle,jobs) 
    319             inpfile%ptim(iobs)         = zjuld(iobs) 
     336            inpfile%ptim(iobs)         = zjuld(jm) 
    320337            inpfile%pdep(1,iobs)       = 0.0 
    321338            ! Integers 
    322339            inpfile%kindex(iobs)       = iobs 
    323             IF ( zsla(jcycle,jobs) == fbrmdi ) THEN 
    324                inpfile%ioqc(iobs)      = 4 
    325                inpfile%ivqc(iobs,1)    = 4  
    326                inpfile%ivlqc(1,iobs,1) = 4 
    327             ELSE  
    328                inpfile%ioqc(iobs)      = 1 
    329                inpfile%ivqc(iobs,1)    = 1 
    330                inpfile%ivlqc(1,iobs,1) = 1 
    331             ENDIF 
     340            inpfile%ioqc(iobs)      = 1 
     341            inpfile%ivqc(iobs,1)    = 1 
     342            inpfile%ivlqc(1,iobs,1) = 1 
    332343            inpfile%ipqc(iobs)         = 0  
    333344            inpfile%ipqcf(:,iobs)      = 0 
    … …  
    354365         & ipdataindexes, & 
    355366         & zsla,          & 
    356          & zjuld          & 
     367         & zjuld,         & 
     368         & llskip         & 
    357369         & ) 
    358370 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_sla_types.h90

    r2001 r2074  
    1    INTEGER, PARAMETER :: & 
    2       & imaxmissions=7 
     1   INTEGER, PARAMETER :: imaxmissions=8 
    32   CHARACTER(len=3) :: cmissions(0:imaxmissions) = & 
    4       & (/ 'XXX', 'E1 ', 'E2 ', 'TP ', 'TPM', 'G2 ', 'J1 ', 'EN ' /) 
     3      & (/ 'XXX', 'E1 ', 'E2 ', 'TP ', 'TPM', 'G2 ', 'J1 ', 'EN ', 'J2 ' /) 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_sort.F90

    r2001 r2074  
    3838 
    3939      !! * Arguments 
    40       INTEGER, INTENT(IN) :: & 
    41          & kvals            ! Number of elements to be sorted 
     40      INTEGER, INTENT(IN) :: kvals     ! Number of elements to be sorted 
    4241      REAL(KIND=dp), DIMENSION(kvals), INTENT(IN) :: & 
    4342         & pvals            ! Array to be sorted 
    … …  
    7675 
    7776      !! * Arguments 
    78       INTEGER, INTENT(IN) :: & 
    79          & kvals                           ! Number of values 
     77      INTEGER, INTENT(IN) :: kvals         ! Number of values 
    8078      REAL(KIND=dp), DIMENSION(kvals), INTENT(IN) :: & 
    8179         & pval                            ! Array to be sorted 
    … …  
    8482 
    8583      !! * Local declarations 
    86       INTEGER :: & 
    87          & ji,      & 
    88          & jj,      & 
    89          & jt,      & 
    90          & jn,      & 
    91          & jparent, & 
    92          & jchild 
     84      INTEGER :: ji 
     85      INTEGER :: jj 
     86      INTEGER :: jt 
     87      INTEGER :: jn 
     88      INTEGER :: jparent 
     89      INTEGER :: jchild 
    9390 
    9491      DO ji = 1, kvals 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_sst_io.h90

    r2001 r2074  
    2323      !! * Local declarations 
    2424      CHARACTER(LEN=12),PARAMETER :: cpname = 'read_ghrsst' 
    25       INTEGER :: & 
    26          & i_file_id, &     ! netcdf IDS 
    27          & i_time_id, & 
    28          & i_ni_id,   & 
    29          & i_data_id, & 
    30          & i_var_id 
    31       INTEGER ::  & 
    32          & i_data, &        ! Number of data per parameter in current file 
    33          & i_time           ! Number of reference times in file 
     25      INTEGER :: i_file_id        ! netcdf IDS 
     26      INTEGER :: i_time_id 
     27      INTEGER :: i_ni_id 
     28      INTEGER :: i_data_id 
     29      INTEGER :: i_var_id 
     30      INTEGER :: i_data           ! Number of data per parameter in current file 
     31      INTEGER :: i_time           ! Number of reference times in file 
    3432      INTEGER, DIMENSION(:), POINTER :: & 
    3533         & i_reftime        ! Reference time in file in seconds since 1/1/1981. 
    … …  
    4341      REAL(wp), DIMENSION(:,:), POINTER :: & 
    4442         & z_sst            ! SST data      
    45       INTEGER, PARAMETER :: & 
    46          & imaxdim = 2      ! Assumed maximum for no. dims. in file 
    47       INTEGER, DIMENSION(2) :: & 
    48          & idims            ! Dimensions in file 
    49       INTEGER :: &                   
    50          & iilen, &         ! Length of netCDF attributes 
    51          & itype            ! Typeof netCDF attributes 
    52       REAL(KIND=wp) :: & 
    53          & zsca, &          ! Scale factor 
    54          & zoff, &          ! Offset for data in netcdf file 
    55          & z_offset, &      ! Offset for time conversion 
    56          & zfill            ! Fill value in netcdf file 
    57       CHARACTER (len=33) :: & 
    58          & creftime         ! Reference time of file 
    59       INTEGER :: & 
    60          & i_refyear,  &    ! Integer version of reference time 
    61          & i_refmonth, & 
    62          & i_refday,   & 
    63          & i_refhour,  & 
    64          & i_refmin,   & 
    65          & i_refsec 
    66       INTEGER :: & 
    67          & ichunk 
    68       integer :: & 
    69          & jtim, & 
    70          & jobs, & 
    71          & iobs 
     43      INTEGER, PARAMETER :: imaxdim = 2      ! Assumed maximum for no. dims. in file 
     44      INTEGER, DIMENSION(2) :: idims         ! Dimensions in file 
     45      INTEGER :: iilen            ! Length of netCDF attributes 
     46      INTEGER :: itype            ! Typeof netCDF attributes 
     47      REAL(KIND=wp) :: zsca           ! Scale factor 
     48      REAL(KIND=wp) :: zoff           ! Offset for data in netcdf file 
     49      REAL(KIND=wp) :: z_offset       ! Offset for time conversion 
     50      REAL(KIND=wp) :: zfill          ! Fill value in netcdf file 
     51      CHARACTER (len=33) :: creftime  ! Reference time of file 
     52      INTEGER :: i_refyear            ! Integer version of reference time 
     53      INTEGER :: i_refmonth 
     54      INTEGER :: i_refday 
     55      INTEGER :: i_refhour 
     56      INTEGER :: i_refmin 
     57      INTEGER :: i_refsec 
     58      INTEGER :: ichunk 
     59      INTEGER :: jtim 
     60      INTEGER :: jobs 
     61      INTEGER :: iobs 
    7262 
    7363      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, & 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_surf_def.F90

    r2001 r2074  
    4242      ! Bookkeeping 
    4343 
    44       INTEGER :: & 
    45          & nsurf,    &    !: Local number of surface data within window 
    46          & nsurfmpp, &    !: Global number of surface data within window 
    47          & nvar,     &    !: Number of variables at observation points 
    48          & nextra,   &    !: Number of extra fields at observation points 
    49          & nstp,     &    !: Number of time steps 
    50          & nsurfup        !: Observation counter used in obs_oper 
     44      INTEGER :: nsurf      !: Local number of surface data within window 
     45      INTEGER :: nsurfmpp   !: Global number of surface data within window 
     46      INTEGER :: nvar       !: Number of variables at observation points 
     47      INTEGER :: nextra     !: Number of extra fields at observation points 
     48      INTEGER :: nstp       !: Number of time steps 
     49      INTEGER :: nsurfup    !: Observation counter used in obs_oper 
    5150 
    5251      ! Arrays with size equal to the number of surface observations 
    … …  
    6564         & nqc,  &        !: Surface observation qc flag 
    6665         & ntyp           !: Type of surface observation product 
     66 
     67      CHARACTER(LEN=8), POINTER, DIMENSION(:) :: & 
     68         & cwmo           !: WMO indentifier 
    6769          
    6870      REAL(KIND=wp), POINTER, DIMENSION(:) :: & 
    … …  
    107109      !!---------------------------------------------------------------------- 
    108110      !! * Arguments 
    109       TYPE(obs_surf), INTENT(INOUT) :: & 
    110          & surf      ! Surface data to be allocated 
    111       INTEGER, INTENT(IN) :: & 
    112          & ksurf,  & ! Number of surface observations 
    113          & kvar,   & ! Number of surface variables 
    114          & kextra, & ! Number of extra fields at observation points 
    115          & kstp      ! Number of time steps 
     111      TYPE(obs_surf), INTENT(INOUT) ::  surf      ! Surface data to be allocated 
     112      INTEGER, INTENT(IN) :: ksurf   ! Number of surface observations 
     113      INTEGER, INTENT(IN) :: kvar    ! Number of surface variables 
     114      INTEGER, INTENT(IN) :: kextra  ! Number of extra fields at observation points 
     115      INTEGER, INTENT(IN) :: kstp    ! Number of time steps 
    116116 
    117117      !!* Local variables 
    118       INTEGER :: & 
    119          & ji 
     118      INTEGER :: ji 
    120119 
    121120      ! Set bookkeeping variables 
    … …  
    142141         & surf%nqc(ksurf),     & 
    143142         & surf%ntyp(ksurf),    & 
     143         & surf%cwmo(ksurf),    & 
    144144         & surf%rlam(ksurf),    & 
    145145         & surf%rphi(ksurf),    & 
    … …  
    217217         & surf%nqc,     & 
    218218         & surf%ntyp,    & 
     219         & surf%cwmo,    & 
    219220         & surf%rlam,    & 
    220221         & surf%rphi,    & 
    … …  
    263264      !!---------------------------------------------------------------------- 
    264265      !! * Arguments 
    265       TYPE(obs_surf), INTENT(IN)    :: & 
    266          & surf          ! Original surface data 
    267       TYPE(obs_surf), INTENT(INOUT) :: & 
    268          & newsurf       ! New surface data with a subset of the original data 
    269       LOGICAL :: & 
    270          & lallocate     ! Allocate newsurf data 
    271       INTEGER,INTENT(IN) :: & 
    272          & kumout        ! Fortran unit for messages 
     266      TYPE(obs_surf), INTENT(IN)    :: surf      ! Original surface data 
     267      TYPE(obs_surf), INTENT(INOUT) :: newsurf   ! New surface data with a subset of the original data 
     268      LOGICAL :: lallocate     ! Allocate newsurf data 
     269      INTEGER,INTENT(IN) :: kumout        ! Fortran unit for messages 
    273270      LOGICAL, OPTIONAL, INTENT(in), DIMENSION(:) :: & 
    274271         & lvalid         ! Valid of surface observations 
    275272       
    276273      !!* Local variables 
    277       INTEGER :: & 
    278          & insurf 
    279       INTEGER :: & 
    280          & ji, & 
    281          & jk 
    282       LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
    283          & llvalid 
     274      INTEGER :: insurf 
     275      INTEGER :: ji 
     276      INTEGER :: jk 
     277      LOGICAL, DIMENSION(:), ALLOCATABLE :: llvalid 
    284278 
    285279      ! Count how many elements there should be in the new data structure 
    … …  
    338332            newsurf%nqc(insurf)   = surf%nqc(ji) 
    339333            newsurf%ntyp(insurf)  = surf%ntyp(ji) 
     334            newsurf%cwmo(insurf)  = surf%cwmo(ji) 
    340335            newsurf%rlam(insurf)  = surf%rlam(ji) 
    341336            newsurf%rphi(insurf)  = surf%rphi(ji) 
    … …  
    352347               newsurf%rext(insurf,jk) = surf%rext(ji,jk) 
    353348 
    354             ENDDO 
     349            END DO 
    355350             
    356351            ! nsind is the index of the original surface data 
    … …  
    392387      !!---------------------------------------------------------------------- 
    393388      !! * Arguments 
    394       TYPE(obs_surf),INTENT(INOUT) :: & 
    395          & surf        ! Updated surface data 
    396       TYPE(obs_surf),INTENT(INOUT) :: & 
    397          & oldsurf     ! Original surface data 
    398       LOGICAL :: & 
    399          & ldeallocate ! Deallocate the updated data of insertion 
    400       INTEGER,INTENT(in) :: & 
    401          & kumout      ! Output unit 
     389      TYPE(obs_surf),INTENT(INOUT) :: surf       ! Updated surface data 
     390      TYPE(obs_surf),INTENT(INOUT) :: oldsurf    ! Original surface data 
     391      LOGICAL :: ldeallocate ! Deallocate the updated data of insertion 
     392      INTEGER,INTENT(in) :: kumout      ! Output unit 
    402393       
    403394      !!* Local variables 
    404       INTEGER :: & 
    405          & ji, & 
    406          & jj, & 
    407          & jk 
     395      INTEGER :: ji 
     396      INTEGER :: jj 
     397      INTEGER :: jk 
    408398 
    409399      ! Copy data from surf to old surf 
    … …  
    425415         oldsurf%nqc(jj)   = surf%nqc(ji) 
    426416         oldsurf%ntyp(jj)  = surf%ntyp(ji) 
     417         oldsurf%cwmo(jj)  = surf%cwmo(ji) 
    427418         oldsurf%rlam(jj)  = surf%rlam(ji) 
    428419         oldsurf%rphi(jj)  = surf%rphi(ji) 
    … …  
    439430            oldsurf%rmod(jj,jk)  = surf%rmod(ji,jk) 
    440431 
    441          ENDDO 
    442  
    443       ENDDO 
     432         END DO 
     433 
     434      END DO 
    444435 
    445436      DO jk = 1, surf%nextra 
    … …  
    451442            oldsurf%rext(jj,jk)  = surf%rext(ji,jk) 
    452443 
    453          ENDDO 
    454  
    455       ENDDO 
     444         END DO 
     445 
     446      END DO 
    456447 
    457448      ! Optionally deallocate the updated surface data 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_types.F90

    r2001 r2074  
    4040   CHARACTER(LEN=3), PUBLIC, DIMENSION(0:ntyp1770) :: ctypshort 
    4141 
    42    INTEGER, PUBLIC, PARAMETER :: ntypalt = 7 
     42   INTEGER, PUBLIC, PARAMETER :: ntypalt = 8 
    4343   CHARACTER(LEN=40), PUBLIC, DIMENSION(0:ntypalt) :: calttyp 
    4444 
    … …  
    106106 
    107107      !! * Local declarations 
    108       INTEGER :: & 
    109          & ji 
     108      INTEGER :: ji 
    110109 
    111110      DO ji = 0, ntyp1770 
    … …  
    190189      DO ji = 853, 854 
    191190         cwmonam1770(ji) = 'Reserved' 
    192       ENDDO 
     191      END DO 
    193192 
    194193      DO ji = 859, 899 
    195194         cwmonam1770(ji) = 'Reserved' 
    196       ENDDO 
     195      END DO 
    197196 
    198197      DO ji = 901, 999 
    199198         cwmonam1770(ji) = 'Reserved' 
    200       ENDDO 
     199      END DO 
    201200 
    202201      DO ji = 1000, 1022 
    203202         cwmonam1770(ji) = 'Reserved' 
    204       ENDDO 
     203      END DO 
    205204 
    206205      ctypshort(800) = 'MBT' 
    … …  
    256255      calttyp(6) = 'Jason-1' 
    257256      calttyp(7) = 'Envisat' 
    258        
     257      calttyp(8) = 'Jason-2' 
     258 
    259259   END SUBROUTINE obs_alt_typ_init 
    260260 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_utils.F90

    r2001 r2074  
    6363 
    6464      !! * Arguments 
    65       INTEGER :: & 
    66          & kstatus, & 
    67          & klineno 
    68       CHARACTER(LEN=*) :: & 
    69          & cd_name 
    70        
    71       !! * Local declarations 
    72       CHARACTER(len=200) :: & 
    73          & clineno 
     65      INTEGER :: kstatus 
     66      INTEGER :: klineno 
     67      CHARACTER(LEN=*) :: cd_name 
     68       
     69      !! * Local declarations 
     70      CHARACTER(len=200) :: clineno 
    7471 
    7572      ! Main computation 
    … …  
    10299 
    103100      !! * Arguments 
    104       INTEGER :: & 
    105          & kfileid, &    ! NetCDF file id    
    106          & kvarid,  &    ! NetCDF variable id    
    107          & kndim         ! Expected number of dimensions 
    108       INTEGER, DIMENSION(kndim) :: & 
    109          & kdim          ! Expected dimensions 
    110       CHARACTER(LEN=*) :: & 
    111          & cd_name       ! Calling routine name 
    112       INTEGER :: & 
    113          & klineno       ! Calling line number 
    114  
    115       !! * Local declarations 
    116       INTEGER :: & 
    117          & indim 
     101      INTEGER :: kfileid       ! NetCDF file id    
     102      INTEGER :: kvarid        ! NetCDF variable id    
     103      INTEGER :: kndim         ! Expected number of dimensions 
     104      INTEGER, DIMENSION(kndim) :: kdim      ! Expected dimensions 
     105      CHARACTER(LEN=*) :: cd_name            ! Calling routine name 
     106      INTEGER ::  klineno      ! Calling line number 
     107 
     108      !! * Local declarations 
     109      INTEGER :: indim 
    118110      INTEGER, ALLOCATABLE, DIMENSION(:) :: & 
    119111         & idim,ilendim 
    120       INTEGER :: & 
    121          & ji 
    122       LOGICAL :: & 
    123          & llerr 
    124       CHARACTER(len=200) :: & 
    125          & clineno 
    126  
     112      INTEGER :: ji 
     113      LOGICAL :: llerr 
     114      CHARACTER(len=200) :: clineno 
    127115 
    128116      CALL chkerr( nf90_inquire_variable( kfileid, kvarid, ndims=indim ), & 
    … …  
    176164 
    177165      !! * Arguments 
    178       INTEGER :: & 
    179          & klineno 
    180       CHARACTER(LEN=*) :: & 
    181          & cd_name 
    182       !! * Local declarations 
    183       CHARACTER(len=200) :: & 
    184          & clineno 
     166      INTEGER :: klineno 
     167      CHARACTER(LEN=*) :: cd_name 
     168      !! * Local declarations 
     169      CHARACTER(len=200) :: clineno 
    185170 
    186171      WRITE(clineno,'(A,I8)')' at line number ', klineno 
    … …  
    206191 
    207192      !! * Arguments 
    208       INTEGER :: & 
    209          & klineno 
    210       CHARACTER(LEN=*) :: & 
    211          & cd_name 
    212       !! * Local declarations 
    213       CHARACTER(len=200) :: & 
    214          & clineno 
     193      INTEGER :: klineno 
     194      CHARACTER(LEN=*) :: cd_name 
     195      !! * Local declarations 
     196      CHARACTER(len=200) :: clineno 
    215197 
    216198      WRITE(clineno,'(A,I8)')' at line number ', klineno 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_vel_io.h90

    r2001 r2074  
    2121      LOGICAL          :: ldgrid     ! Save grid info in data structure 
    2222      !! * Local declarations 
    23       INTEGER  :: & 
    24          & iobs, &                   ! Number of observations 
    25          & ilev, &                   ! Number of levels 
    26          & ilat, &                   ! Number of latitudes 
    27          & ilon, &                   ! Number of longtudes 
    28          & itim                      ! Number of obs. times 
    29       INTEGER :: & 
    30          & i_file_id,                & 
    31          & i_dimid_id,               & 
    32          & i_phi_id,                 &  
    33          & i_lam_id,                 & 
    34          & i_depth_id,               & 
    35          & i_var_id,                 & 
    36          & i_time_id,                & 
    37          & i_time2_id,               & 
    38          & i_qc_var_id 
    39       CHARACTER(LEN=40) :: &  
    40          & cl_fld_lam,                 & 
    41          & cl_fld_phi,                 & 
    42          & cl_fld_depth,               & 
    43          & cl_fld_var_u,               & 
    44          & cl_fld_var_v,               & 
    45          & cl_fld_var_qc_uv1,          & 
    46          & cl_fld_var_qc_uv2,          & 
    47          & cl_fld_time,                & 
    48          & cl_fld_time2 
    49       INTEGER :: & 
    50          & ja, & 
    51          & jo, & 
    52          & jk, & 
    53          & jt 
     23      INTEGER :: iobs                ! Number of observations 
     24      INTEGER :: ilev                ! Number of levels 
     25      INTEGER :: ilat                ! Number of latitudes 
     26      INTEGER :: ilon                ! Number of longtudes 
     27      INTEGER :: itim                ! Number of obs. times 
     28      INTEGER :: i_file_id 
     29      INTEGER :: i_dimid_id 
     30      INTEGER :: i_phi_id 
     31      INTEGER :: i_lam_id 
     32      INTEGER :: i_depth_id 
     33      INTEGER :: i_var_id 
     34      INTEGER :: i_time_id 
     35      INTEGER :: i_time2_id 
     36      INTEGER :: i_qc_var_id 
     37      CHARACTER(LEN=40) :: cl_fld_lam 
     38      CHARACTER(LEN=40) :: cl_fld_phi 
     39      CHARACTER(LEN=40) :: cl_fld_depth 
     40      CHARACTER(LEN=40) :: cl_fld_var_u 
     41      CHARACTER(LEN=40) :: cl_fld_var_v 
     42      CHARACTER(LEN=40) :: cl_fld_var_qc_uv1 
     43      CHARACTER(LEN=40) :: cl_fld_var_qc_uv2 
     44      CHARACTER(LEN=40) :: cl_fld_time 
     45      CHARACTER(LEN=40) :: cl_fld_time2 
     46      INTEGER :: ja 
     47      INTEGER :: jo 
     48      INTEGER :: jk 
     49      INTEGER :: jt 
    5450      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: & 
    5551         & zv,     & 
    … …  
    6258         & zlon, & 
    6359         & zjuld 
    64       REAL(wp) :: & 
    65          & zl 
     60      REAL(wp) :: zl 
    6661      INTEGER, ALLOCATABLE, DIMENSION(:) :: & 
    6762         & itime, & 
    6863         & itime2 
    69       CHARACTER(LEN=50) :: & 
    70          & cdjulref 
    71       CHARACTER(LEN=12), PARAMETER :: & 
    72          & cl_name = 'read_taondbc' 
     64      CHARACTER(LEN=50) :: cdjulref 
     65      CHARACTER(LEN=12), PARAMETER :: cl_name = 'read_taondbc' 
    7366      CHARACTER(len=1) :: cns, cew 
    7467 
    … …  
    252245         zjuld(jt) = REAL(itime(jt),wp) + REAL(itime2(jt),wp)/86400000.0_wp & 
    253246            &           - 2433283.0_wp 
    254       ENDDO 
     247      END DO 
    255248      inpfile%cdjuldref = '19500101000000' 
    256249 
    … …  
    283276                  inpfile%pdep(jk,iobs)      = zdep(jk) 
    284277                  inpfile%ivlqc(jk,iobs,1:2) = INT( MAX( zuv1qc(jo,ja,jk,jt), zuv2qc(jo,ja,jk,jt) ) ) 
    285                ENDDO 
     278               END DO 
    286279               inpfile%plam(iobs) = zlon(jo) 
    287280               inpfile%pphi(iobs) = zlat(ja) 
    288281               inpfile%ptim(iobs) = zjuld(jt) 
    289             ENDDO 
    290          ENDDO 
    291       ENDDO 
     282            END DO 
     283         END DO 
     284      END DO 
    292285 
    293286      ! No position, time, depth and variable QC in input files 
    … …  
    298291         DO jk = 1, ilev 
    299292            inpfile%idqc(jk,jo) = 1 
    300          ENDDO 
    301       ENDDO 
     293         END DO 
     294      END DO 
    302295 
    303296      !--------------------------------------------------------------------- 
    … …  
    321314               inpfile%pob(jk,jo,2) = 0.01 * inpfile%pob(jk,jo,2) 
    322315            ENDIF 
    323          ENDDO 
    324       ENDDO 
     316         END DO 
     317      END DO 
    325318 
    326319      !--------------------------------------------------------------------- 
    … …  
    330323      DO jo = 1, inpfile%nobs 
    331324         inpfile%kindex(jo) = jo 
    332       ENDDO 
     325      END DO 
    333326 
    334327      !--------------------------------------------------------------------- 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_write.F90

    r2001 r2074  
    4141      &   obs_wri_sss, &    ! Write SSS observation related diagnostics 
    4242      &   obs_wri_seaice, & ! Write seaice observation related diagnostics 
    43       &   obs_wri_vel       ! Write velocity observation related diagnostics 
     43      &   obs_wri_vel, &    ! Write velocity observation related diagnostics 
     44      &   obswriinfo 
     45    
     46   TYPE obswriinfo 
     47      INTEGER :: inum 
     48      INTEGER, POINTER, DIMENSION(:) :: ipoint 
     49      CHARACTER(len=ilenname), POINTER, DIMENSION(:) :: cdname 
     50      CHARACTER(len=ilenlong), POINTER, DIMENSION(:,:) :: cdlong 
     51      CHARACTER(len=ilenunit), POINTER, DIMENSION(:,:) :: cdunit 
     52   END TYPE obswriinfo 
    4453 
    4554CONTAINS 
    4655 
    47    SUBROUTINE obs_wri_p3d( cprefix, profdata ) 
     56   SUBROUTINE obs_wri_p3d( cprefix, profdata, padd, pext ) 
    4857      !!----------------------------------------------------------------------- 
    4958      !! 
    … …  
    6978 
    7079      !! * Arguments 
    71       CHARACTER(LEN=*), INTENT(IN) :: & 
    72          & cprefix            ! Prefix for output files 
    73       TYPE(obs_prof), INTENT(INOUT) :: & 
    74          & profdata           ! Full set of profile data 
    75  
     80      CHARACTER(LEN=*), INTENT(IN) :: cprefix        ! Prefix for output files 
     81      TYPE(obs_prof), INTENT(INOUT) :: profdata      ! Full set of profile data 
     82      TYPE(obswriinfo), OPTIONAL :: padd             ! Additional info for each variable 
     83      TYPE(obswriinfo), OPTIONAL :: pext             ! Extra info 
     84       
    7685      !! * Local declarations 
    7786      TYPE(obfbdata) :: fbdata 
    78       CHARACTER(LEN=40) :: &  
    79          & cfname 
    80       INTEGER :: & 
    81          & ilevel 
    82       INTEGER :: & 
    83          & jvar, & 
    84          & jo, & 
    85          & jk, & 
    86          & ik 
    87       REAL(wp) :: & 
    88          & zpres 
    89  
     87      CHARACTER(LEN=40) :: cfname 
     88      INTEGER :: ilevel 
     89      INTEGER :: jvar 
     90      INTEGER :: jo 
     91      INTEGER :: jk 
     92      INTEGER :: ik 
     93      INTEGER :: ja 
     94      INTEGER :: je 
     95      REAL(wp) :: zpres 
     96      INTEGER :: nadd 
     97      INTEGER :: next 
     98 
     99      IF ( PRESENT( padd ) ) THEN 
     100         nadd = padd%inum 
     101      ELSE 
     102         nadd = 0 
     103      ENDIF 
     104 
     105      IF ( PRESENT( pext ) ) THEN 
     106         next = pext%inum 
     107      ELSE 
     108         next = 0 
     109      ENDIF 
     110       
    90111      CALL init_obfbdata( fbdata ) 
    91112 
    … …  
    94115      DO jvar = 1, 2 
    95116         ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) ) 
    96       ENDDO 
    97       CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 1, 1, .TRUE. ) 
     117      END DO 
     118      CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, & 
     119         &                 1 + nadd, 1 + next, .TRUE. ) 
    98120 
    99121      fbdata%cname(1)      = 'POTM' 
    … …  
    101123      fbdata%coblong(1)    = 'Potential temperature' 
    102124      fbdata%coblong(2)    = 'Practical salinity' 
    103       fbdata%cobunit(1)    = 'Degrees Celsius' 
     125      fbdata%cobunit(1)    = 'Degrees centigrade' 
    104126      fbdata%cobunit(2)    = 'PSU' 
    105127      fbdata%cextname(1)   = 'TEMP' 
    106128      fbdata%cextlong(1)   = 'Insitu temperature' 
    107       fbdata%cextunit(1)   = 'Degrees Celsius' 
     129      fbdata%cextunit(1)   = 'Degrees centigrade' 
     130      DO je = 1, next 
     131         fbdata%cextname(1+je) = pext%cdname(je) 
     132         fbdata%cextlong(1+je) = pext%cdlong(je,1) 
     133         fbdata%cextunit(1+je) = pext%cdunit(je,1) 
     134      END DO 
    108135      fbdata%caddname(1)   = 'Hx' 
    109136      fbdata%caddlong(1,1) = 'Model interpolated potential temperature' 
    110137      fbdata%caddlong(1,2) = 'Model interpolated practical salinity' 
    111       fbdata%caddunit(1,1) = 'Degrees Celsius' 
     138      fbdata%caddunit(1,1) = 'Degrees centigrade' 
    112139      fbdata%caddunit(1,2) = 'PSU' 
    113  
     140      fbdata%cgrid(:)      = 'T' 
     141      DO ja = 1, nadd 
     142         fbdata%caddname(1+ja) = padd%cdname(ja) 
     143         DO jvar = 1, 2 
     144            fbdata%caddlong(1+ja,jvar) = padd%cdlong(ja,jvar) 
     145            fbdata%caddunit(1+ja,jvar) = padd%cdunit(ja,jvar) 
     146         END DO 
     147      END DO 
     148          
    114149      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 
    115150 
    … …  
    151186               fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar)) 
    152187            ENDIF 
    153          ENDDO 
     188         END DO 
    154189         CALL greg2jul( 0, & 
    155190            &           profdata%nmin(jo), & 
    … …  
    178213               ENDIF 
    179214               fbdata%iobsk(ik,jo,jvar)  = profdata%var(jvar)%mvk(jk) 
     215               DO ja = 1, nadd 
     216                  fbdata%padd(ik,jo,1+ja,jvar) = & 
     217                     & profdata%var(jvar)%vext(jk,padd%ipoint(ja)) 
     218               END DO 
     219               DO je = 1, next 
     220                  fbdata%pext(ik,jo,1+je) = & 
     221                     & profdata%var(jvar)%vext(jk,pext%ipoint(je)) 
     222               END DO 
    180223               IF ( jvar == 1 ) THEN 
    181224                  fbdata%pext(ik,jo,1) = profdata%var(jvar)%vext(jk,1) 
    … …  
    201244                     &                     zpres, 0.0_wp ) 
    202245               ENDIF 
    203             ENDDO 
    204          ENDIF 
    205       ENDDO 
     246            END DO 
     247         ENDIF 
     248      END DO 
    206249       
    207250      ! Write the obfbdata structure 
    … …  
    212255   END SUBROUTINE obs_wri_p3d 
    213256 
    214    SUBROUTINE obs_wri_sla( cprefix, sladata ) 
     257   SUBROUTINE obs_wri_sla( cprefix, sladata, padd, pext ) 
    215258      !!----------------------------------------------------------------------- 
    216259      !! 
    … …  
    232275 
    233276      !! * Arguments 
    234       CHARACTER(LEN=*), INTENT(IN) :: & 
    235          & cprefix            ! Prefix for output files 
    236       TYPE(obs_surf), INTENT(INOUT) :: & 
    237          & sladata            ! Full set of SLAa 
     277      CHARACTER(LEN=*), INTENT(IN) :: cprefix          ! Prefix for output files 
     278      TYPE(obs_surf), INTENT(INOUT) :: sladata         ! Full set of SLAa 
     279      TYPE(obswriinfo), OPTIONAL :: padd               ! Additional info for each variable 
     280      TYPE(obswriinfo), OPTIONAL :: pext               ! Extra info 
    238281 
    239282      !! * Local declarations 
    240283      TYPE(obfbdata) :: fbdata 
    241       CHARACTER(LEN=40) :: &  
    242          & cfname             ! netCDF filename 
    243       CHARACTER(LEN=12), PARAMETER :: & 
    244          & cpname = 'obs_wri_sla' 
    245       INTEGER :: & 
    246          & jo 
     284      CHARACTER(LEN=40) :: cfname         ! netCDF filename 
     285      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_sla' 
     286      INTEGER :: jo 
     287      INTEGER :: ja 
     288      INTEGER :: je 
     289      INTEGER :: nadd 
     290      INTEGER :: next 
     291 
     292      IF ( PRESENT( padd ) ) THEN 
     293         nadd = padd%inum 
     294      ELSE 
     295         nadd = 0 
     296      ENDIF 
     297 
     298      IF ( PRESENT( pext ) ) THEN 
     299         next = pext%inum 
     300      ELSE 
     301         next = 0 
     302      ENDIF 
    247303 
    248304      CALL init_obfbdata( fbdata ) 
    249305 
    250       CALL alloc_obfbdata( fbdata, 1, sladata%nsurf, 1, 1, 2, .TRUE. ) 
     306      CALL alloc_obfbdata( fbdata, 1, sladata%nsurf, 1, & 
     307         &                 2 + nadd, 1 + next, .TRUE. ) 
    251308 
    252309      fbdata%cname(1)      = 'SLA' 
    253310      fbdata%coblong(1)    = 'Sea level anomaly' 
    254       fbdata%cobunit(1)    = 'metre' 
    255       fbdata%cextname(1)   = 'SSH' 
    256       fbdata%cextlong(1)   = 'Model Sea surface height' 
    257       fbdata%cextunit(1)   = 'metre' 
    258       fbdata%cextname(2)   = 'MDT' 
    259       fbdata%cextlong(2)   = 'Mean dynamic topography' 
    260       fbdata%cextunit(2)   = 'metre' 
     311      fbdata%cobunit(1)    = 'Metres' 
     312      fbdata%cextname(1)   = 'MDT' 
     313      fbdata%cextlong(1)   = 'Mean dynamic topography' 
     314      fbdata%cextunit(1)   = 'Metres' 
     315      DO je = 1, next 
     316         fbdata%cextname(1+je) = pext%cdname(je) 
     317         fbdata%cextlong(1+je) = pext%cdlong(je,1) 
     318         fbdata%cextunit(1+je) = pext%cdunit(je,1) 
     319      END DO 
    261320      fbdata%caddname(1)   = 'Hx' 
    262321      fbdata%caddlong(1,1) = 'Model interpolated SSH - MDT' 
    263       fbdata%caddunit(1,1) = 'metre' 
     322      fbdata%caddunit(1,1) = 'Metres'  
     323      fbdata%caddname(2)   = 'SSH' 
     324      fbdata%caddlong(2,1) = 'Model Sea surface height' 
     325      fbdata%caddunit(2,1) = 'Metres' 
    264326      fbdata%cgrid(1)      = 'T' 
     327      DO ja = 1, nadd 
     328         fbdata%caddname(2+ja) = padd%cdname(ja) 
     329         fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1) 
     330         fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1) 
     331      END DO 
    265332 
    266333      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 
    … …  
    293360         fbdata%itqc(jo)      = 0 
    294361         fbdata%itqcf(:,jo)   = 0 
    295          fbdata%cdwmo(jo)     = cmissions(sladata%ntyp(jo)) 
     362         fbdata%cdwmo(jo)     = sladata%cwmo(jo) 
    296363         fbdata%kindex(jo)    = sladata%nsfil(jo) 
    297364         IF (ln_grid_global) THEN 
    … …  
    311378            &           krefdate = 19500101 ) 
    312379         fbdata%padd(1,jo,1,1) = sladata%rmod(jo,1) 
    313          fbdata%pob(1,jo,1)    = sladata%robs(jo,1) 
     380         fbdata%padd(1,jo,2,1) = sladata%rext(jo,1) 
     381         fbdata%pob(1,jo,1)    = sladata%robs(jo,1)  
    314382         fbdata%pdep(1,jo)     = 0.0 
    315383         fbdata%idqc(1,jo)     = 0 
    316384         fbdata%idqcf(:,1,jo)  = 0 
    317385         IF ( sladata%nqc(jo) > 10 ) THEN 
    318             fbdata%ivlqc(1,jo,1) = 4 
     386            fbdata%ivqc(jo,1)       = 4 
     387            fbdata%ivlqc(1,jo,1)    = 4 
    319388            fbdata%ivlqcf(1,1,jo,1) = 0 
    320389            fbdata%ivlqcf(2,1,jo,1) = sladata%nqc(jo) - 10 
    321390         ELSE 
    322             fbdata%ivlqc(1,jo,1) = sladata%nqc(jo) 
     391            fbdata%ivqc(jo,1)       = sladata%nqc(jo) 
     392            fbdata%ivlqc(1,jo,1)    = sladata%nqc(jo) 
    323393            fbdata%ivlqcf(:,1,jo,1) = 0 
    324394         ENDIF 
    325395         fbdata%iobsk(1,jo,1)  = 0 
    326          fbdata%pext(1,jo,1) = sladata%rext(jo,1) 
    327          fbdata%pext(1,jo,2) = sladata%rext(jo,2) 
    328  
     396         fbdata%pext(1,jo,1) = sladata%rext(jo,2) 
     397         DO ja = 1, nadd 
     398            fbdata%padd(1,jo,2+ja,1) = & 
     399               & sladata%rext(jo,padd%ipoint(ja)) 
     400         END DO 
     401         DO je = 1, next 
     402            fbdata%pext(1,jo,1+je) = & 
     403               & sladata%rext(jo,pext%ipoint(je)) 
     404         END DO 
    329405      END DO 
    330406 
    … …  
    336412   END SUBROUTINE obs_wri_sla 
    337413 
    338    SUBROUTINE obs_wri_sst( cprefix, sstdata ) 
     414   SUBROUTINE obs_wri_sst( cprefix, sstdata, padd, pext ) 
    339415      !!----------------------------------------------------------------------- 
    340416      !! 
    … …  
    356432 
    357433      !! * Arguments 
    358       CHARACTER(LEN=*), INTENT(IN) :: & 
    359          & cprefix            ! Prefix for output files 
    360       TYPE(obs_surf), INTENT(INOUT) :: & 
    361          & sstdata            ! Full set of SST 
     434      CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files 
     435      TYPE(obs_surf), INTENT(INOUT) :: sstdata      ! Full set of SST 
     436      TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable 
     437      TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info 
    362438 
    363439      !! * Local declarations  
    364440      TYPE(obfbdata) :: fbdata 
    365       CHARACTER(LEN=40) :: &  
    366          & cfname             ! netCDF filename 
    367       CHARACTER(LEN=12), PARAMETER :: & 
    368          & cpname = 'obs_wri_sst' 
    369       INTEGER :: & 
    370          & jo 
     441      CHARACTER(LEN=40) ::  cfname             ! netCDF filename 
     442      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_sst' 
     443      INTEGER :: jo 
     444      INTEGER :: ja 
     445      INTEGER :: je 
     446      INTEGER :: nadd 
     447      INTEGER :: next 
     448 
     449      IF ( PRESENT( padd ) ) THEN 
     450         nadd = padd%inum 
     451      ELSE 
     452         nadd = 0 
     453      ENDIF 
     454 
     455      IF ( PRESENT( pext ) ) THEN 
     456         next = pext%inum 
     457      ELSE 
     458         next = 0 
     459      ENDIF 
    371460 
    372461      CALL init_obfbdata( fbdata ) 
    373462 
    374       CALL alloc_obfbdata( fbdata, 1, sstdata%nsurf, 1, 1, 0, .TRUE. ) 
     463      CALL alloc_obfbdata( fbdata, 1, sstdata%nsurf, 1, & 
     464         &                 1 + nadd, next, .TRUE. ) 
    375465 
    376466      fbdata%cname(1)      = 'SST' 
    377467      fbdata%coblong(1)    = 'Sea surface temperature' 
    378468      fbdata%cobunit(1)    = 'Degree centigrade' 
     469      DO je = 1, next 
     470         fbdata%cextname(je) = pext%cdname(je) 
     471         fbdata%cextlong(je) = pext%cdlong(je,1) 
     472         fbdata%cextunit(je) = pext%cdunit(je,1) 
     473      END DO 
    379474      fbdata%caddname(1)   = 'Hx' 
    380475      fbdata%caddlong(1,1) = 'Model interpolated SST' 
    381476      fbdata%caddunit(1,1) = 'Degree centigrade' 
     477      fbdata%cgrid(1)      = 'T' 
     478      DO ja = 1, nadd 
     479         fbdata%caddname(1+ja) = padd%cdname(ja) 
     480         fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     481         fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     482      END DO 
    382483 
    383484      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 
    … …  
    433534         fbdata%idqcf(:,1,jo)  = 0 
    434535         IF ( sstdata%nqc(jo) > 10 ) THEN 
    435             fbdata%ivlqc(1,jo,1) = 4 
     536            fbdata%ivqc(jo,1)       = 4 
     537            fbdata%ivlqc(1,jo,1)    = 4 
    436538            fbdata%ivlqcf(1,1,jo,1) = 0 
    437539            fbdata%ivlqcf(2,1,jo,1) = sstdata%nqc(jo) - 10 
    438540         ELSE 
    439             fbdata%ivlqc(1,jo,1) = MAX(sstdata%nqc(jo),1) 
     541            fbdata%ivqc(jo,1)       = MAX(sstdata%nqc(jo),1) 
     542            fbdata%ivlqc(1,jo,1)    = MAX(sstdata%nqc(jo),1) 
    440543            fbdata%ivlqcf(:,1,jo,1) = 0 
    441544         ENDIF 
    442545         fbdata%iobsk(1,jo,1)  = 0 
     546         DO ja = 1, nadd 
     547            fbdata%padd(1,jo,1+ja,1) = & 
     548               & sstdata%rext(jo,padd%ipoint(ja)) 
     549         END DO 
     550         DO je = 1, next 
     551            fbdata%pext(1,jo,je) = & 
     552               & sstdata%rext(jo,pext%ipoint(je)) 
     553         END DO 
    443554 
    444555      END DO 
    445556 
    446557      ! Write the obfbdata structure 
     558 
    447559      CALL write_obfbdata( cfname, fbdata ) 
    448560 
    … …  
    454566   END SUBROUTINE obs_wri_sss 
    455567 
    456    SUBROUTINE obs_wri_seaice( cprefix, seaicedata ) 
     568   SUBROUTINE obs_wri_seaice( cprefix, seaicedata, padd, pext ) 
    457569      !!----------------------------------------------------------------------- 
    458570      !! 
    … …  
    474586 
    475587      !! * Arguments 
    476       CHARACTER(LEN=*), INTENT(IN) :: & 
    477          & cprefix            ! Prefix for output files 
    478       TYPE(obs_surf), INTENT(INOUT) :: & 
    479          & seaicedata            ! Full set of sea ice 
     588      CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files 
     589      TYPE(obs_surf), INTENT(INOUT) :: seaicedata   ! Full set of sea ice 
     590      TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable 
     591      TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info 
     592 
     593      !! * Local declarations  
    480594      TYPE(obfbdata) :: fbdata 
    481       CHARACTER(LEN=40) :: &  
    482          & cfname             ! netCDF filename 
    483       CHARACTER(LEN=12), PARAMETER :: & 
    484          & cpname = 'obs_wri_seaice' 
    485       INTEGER :: & 
    486          & jo 
     595      CHARACTER(LEN=40) :: cfname             ! netCDF filename 
     596      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_seaice' 
     597      INTEGER :: jo 
     598      INTEGER :: ja 
     599      INTEGER :: je 
     600      INTEGER :: nadd 
     601      INTEGER :: next 
     602 
     603      IF ( PRESENT( padd ) ) THEN 
     604         nadd = padd%inum 
     605      ELSE 
     606         nadd = 0 
     607      ENDIF 
     608 
     609      IF ( PRESENT( pext ) ) THEN 
     610         next = pext%inum 
     611      ELSE 
     612         next = 0 
     613      ENDIF 
    487614 
    488615      CALL init_obfbdata( fbdata ) 
    … …  
    493620      fbdata%coblong(1)    = 'Sea ice' 
    494621      fbdata%cobunit(1)    = 'Fraction' 
     622      DO je = 1, next 
     623         fbdata%cextname(je) = pext%cdname(je) 
     624         fbdata%cextlong(je) = pext%cdlong(je,1) 
     625         fbdata%cextunit(je) = pext%cdunit(je,1) 
     626      END DO 
    495627      fbdata%caddname(1)   = 'Hx' 
    496628      fbdata%caddlong(1,1) = 'Model interpolated ICE' 
    497629      fbdata%caddunit(1,1) = 'Fraction' 
     630      fbdata%cgrid(1)      = 'T' 
     631      DO ja = 1, nadd 
     632         fbdata%caddname(1+ja) = padd%cdname(ja) 
     633         fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     634         fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     635      END DO 
    498636 
    499637      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 
    … …  
    557695         ENDIF 
    558696         fbdata%iobsk(1,jo,1)  = 0 
     697         DO ja = 1, nadd 
     698            fbdata%padd(1,jo,1+ja,1) = & 
     699               & seaicedata%rext(jo,padd%ipoint(ja)) 
     700         END DO 
     701         DO je = 1, next 
     702            fbdata%pext(1,jo,je) = & 
     703               & seaicedata%rext(jo,pext%ipoint(je)) 
     704         END DO 
    559705 
    560706      END DO 
    … …  
    565711      CALL dealloc_obfbdata( fbdata ) 
    566712 
    567  
    568       !! * Local declarations 
    569713   END SUBROUTINE obs_wri_seaice 
    570714 
    571    SUBROUTINE obs_wri_vel( cprefix, profdata, k2dint ) 
     715   SUBROUTINE obs_wri_vel( cprefix, profdata, k2dint, padd, pext ) 
    572716      !!----------------------------------------------------------------------- 
    573717      !! 
    … …  
    588732 
    589733      !! * Arguments 
    590       CHARACTER(LEN=*), INTENT(IN) :: & 
    591          & cprefix            ! Prefix for output files 
    592       TYPE(obs_prof), INTENT(INOUT) :: & 
    593          & profdata           ! Full set of profile data 
    594       INTEGER, INTENT(IN) :: & 
    595          & k2dint             ! Horizontal interpolation method 
     734      CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files 
     735      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Full set of profile data 
     736      INTEGER, INTENT(IN) :: k2dint                 ! Horizontal interpolation method 
     737      TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable 
     738      TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info 
    596739 
    597740      !! * Local declarations 
    598741      TYPE(obfbdata) :: fbdata 
    599       CHARACTER(LEN=40) :: &  
    600          & cfname 
    601       INTEGER :: & 
    602          & ilevel 
    603       INTEGER :: & 
    604          & jvar, & 
    605          & jo, & 
    606          & jk, & 
    607          & ik 
    608       REAL(wp) :: & 
    609          & zpres 
     742      CHARACTER(LEN=40) :: cfname 
     743      INTEGER :: ilevel 
     744      INTEGER :: jvar 
     745      INTEGER :: jk 
     746      INTEGER :: ik 
     747      INTEGER :: jo 
     748      INTEGER :: ja 
     749      INTEGER :: je 
     750      INTEGER :: nadd 
     751      INTEGER :: next 
     752      REAL(wp) :: zpres 
    610753      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    611754         & zu, & 
    612755         & zv 
     756 
     757      IF ( PRESENT( padd ) ) THEN 
     758         nadd = padd%inum 
     759      ELSE 
     760         nadd = 0 
     761      ENDIF 
     762 
     763      IF ( PRESENT( pext ) ) THEN 
     764         next = pext%inum 
     765      ELSE 
     766         next = 0 
     767      ENDIF 
    613768 
    614769      CALL init_obfbdata( fbdata ) 
    … …  
    618773      DO jvar = 1, 2 
    619774         ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) ) 
    620       ENDDO 
     775      END DO 
    621776      CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 2, 0, .TRUE. ) 
    622777 
    … …  
    627782      fbdata%cobunit(1)    = 'm/s' 
    628783      fbdata%cobunit(2)    = 'm/s' 
     784      DO je = 1, next 
     785         fbdata%cextname(je) = pext%cdname(je) 
     786         fbdata%cextlong(je) = pext%cdlong(je,1) 
     787         fbdata%cextunit(je) = pext%cdunit(je,1) 
     788      END DO 
    629789      fbdata%caddname(1)   = 'Hx' 
    630790      fbdata%caddlong(1,1) = 'Model interpolated zonal velocity' 
    … …  
    632792      fbdata%caddunit(1,1) = 'm/s' 
    633793      fbdata%caddunit(1,2) = 'm/s' 
    634       fbdata%caddname(2)   = 'HxGRID' 
     794      fbdata%caddname(2)   = 'HxG' 
    635795      fbdata%caddlong(2,1) = 'Model interpolated zonal velocity (model grid)' 
    636796      fbdata%caddlong(2,2) = 'Model interpolated meridional velocity (model grid)' 
    637797      fbdata%caddunit(2,1) = 'm/s' 
    638       fbdata%caddunit(2,2) = 'm/s' 
     798      fbdata%caddunit(2,2) = 'm/s'  
     799      fbdata%cgrid(1)      = 'U'  
     800      fbdata%cgrid(2)      = 'V' 
     801      DO ja = 1, nadd 
     802         fbdata%caddname(2+ja) = padd%cdname(ja) 
     803         fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1) 
     804         fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1) 
     805      END DO 
    639806 
    640807      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 
    … …  
    683850               fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar)) 
    684851            ENDIF 
    685          ENDDO 
     852         END DO 
    686853         CALL greg2jul( 0, & 
    687854            &           profdata%nmin(jo), & 
    … …  
    715882               ENDIF 
    716883               fbdata%iobsk(ik,jo,jvar)  = profdata%var(jvar)%mvk(jk) 
     884               DO ja = 1, nadd 
     885                  fbdata%padd(ik,jo,2+ja,jvar) = & 
     886                     & profdata%var(jvar)%vext(jk,padd%ipoint(ja)) 
     887               END DO 
     888               DO je = 1, next 
     889                  fbdata%pext(ik,jo,je) = & 
     890                     & profdata%var(jvar)%vext(jk,pext%ipoint(je)) 
     891               END DO 
    717892            END DO 
    718893         END DO 

  • branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/str_c_to_for.h90

    r2001 r2074  
    2020      !!--------------------------------------------------------------------- 
    2121      !! * Arguments 
    22       CHARACTER(LEN=*), INTENT(INOUT) :: & 
    23          & cd_str 
     22      CHARACTER(LEN=*), INTENT(INOUT) :: cd_str 
    2423 
    2524      !! * Local declarations 
Note: See TracChangeset for help on using the changeset viewer.