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 7351 for branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90 – NEMO

Ignore:
Timestamp:
2016-11-28T17:04:10+01:00 (7 years ago)
Author:
emanuelaclementi
Message:

ticket #1805 step 3: /2016/dev_INGV_UKMO_2016 aligned to the trunk at revision 7161

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90

    r3294 r7351  
    5050CONTAINS 
    5151 
    52    SUBROUTINE obs_rea_altbias( kslano, sladata, k2dint, bias_file ) 
     52   SUBROUTINE obs_rea_altbias( sladata, k2dint, bias_file ) 
    5353      !!--------------------------------------------------------------------- 
    5454      !! 
     
    7070      ! 
    7171      !! * Arguments 
    72       INTEGER, INTENT(IN) :: kslano      ! Number of SLA Products 
    73       TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: & 
     72      TYPE(obs_surf), INTENT(INOUT) :: & 
    7473         & sladata       ! SLA data 
    7574      INTEGER, INTENT(IN) :: k2dint 
     
    8079      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_rea_altbias' 
    8180 
    82       INTEGER :: jslano       ! Data set loop variable 
    8381      INTEGER :: jobs         ! Obs loop variable 
    8482      INTEGER :: jpialtbias   ! Number of grid point in latitude for the bias 
     
    144142      ! Intepolate the bias already on the model grid at the observation point 
    145143   
    146       DO jslano = 1, kslano 
    147  
    148          ALLOCATE( & 
    149             & igrdi(2,2,sladata(jslano)%nsurf), & 
    150             & igrdj(2,2,sladata(jslano)%nsurf), & 
    151             & zglam(2,2,sladata(jslano)%nsurf), & 
    152             & zgphi(2,2,sladata(jslano)%nsurf), & 
    153             & zmask(2,2,sladata(jslano)%nsurf), & 
    154             & zbias(2,2,sladata(jslano)%nsurf)  & 
    155             & ) 
    156           
    157          DO jobs = 1, sladata(jslano)%nsurf 
    158  
    159             igrdi(1,1,jobs) = sladata(jslano)%mi(jobs)-1 
    160             igrdj(1,1,jobs) = sladata(jslano)%mj(jobs)-1 
    161             igrdi(1,2,jobs) = sladata(jslano)%mi(jobs)-1 
    162             igrdj(1,2,jobs) = sladata(jslano)%mj(jobs) 
    163             igrdi(2,1,jobs) = sladata(jslano)%mi(jobs) 
    164             igrdj(2,1,jobs) = sladata(jslano)%mj(jobs)-1 
    165             igrdi(2,2,jobs) = sladata(jslano)%mi(jobs) 
    166             igrdj(2,2,jobs) = sladata(jslano)%mj(jobs) 
    167  
    168          END DO 
    169  
    170          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 
    171             &                  igrdi, igrdj, glamt, zglam ) 
    172          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 
    173             &                  igrdi, igrdj, gphit, zgphi ) 
    174          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 
    175             &                  igrdi, igrdj, tmask(:,:,1), zmask ) 
    176          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 
    177             &                  igrdi, igrdj, z_altbias, zbias ) 
    178  
    179          DO jobs = 1, sladata(jslano)%nsurf 
    180  
    181             zlam = sladata(jslano)%rlam(jobs) 
    182             zphi = sladata(jslano)%rphi(jobs) 
    183             iico = sladata(jslano)%mi(jobs) 
    184             ijco = sladata(jslano)%mj(jobs) 
     144      ALLOCATE( & 
     145         & igrdi(2,2,sladata%nsurf), & 
     146         & igrdj(2,2,sladata%nsurf), & 
     147         & zglam(2,2,sladata%nsurf), & 
     148         & zgphi(2,2,sladata%nsurf), & 
     149         & zmask(2,2,sladata%nsurf), & 
     150         & zbias(2,2,sladata%nsurf)  & 
     151         & ) 
     152          
     153      DO jobs = 1, sladata%nsurf 
     154 
     155         igrdi(1,1,jobs) = sladata%mi(jobs)-1 
     156         igrdj(1,1,jobs) = sladata%mj(jobs)-1 
     157         igrdi(1,2,jobs) = sladata%mi(jobs)-1 
     158         igrdj(1,2,jobs) = sladata%mj(jobs) 
     159         igrdi(2,1,jobs) = sladata%mi(jobs) 
     160         igrdj(2,1,jobs) = sladata%mj(jobs)-1 
     161         igrdi(2,2,jobs) = sladata%mi(jobs) 
     162         igrdj(2,2,jobs) = sladata%mj(jobs) 
     163 
     164      END DO 
     165 
     166      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
     167         &                  igrdi, igrdj, glamt, zglam ) 
     168      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
     169         &                  igrdi, igrdj, gphit, zgphi ) 
     170      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
     171         &                  igrdi, igrdj, tmask(:,:,1), zmask ) 
     172      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
     173         &                  igrdi, igrdj, z_altbias, zbias ) 
     174 
     175      DO jobs = 1, sladata%nsurf 
     176 
     177         zlam = sladata%rlam(jobs) 
     178         zphi = sladata%rphi(jobs) 
     179         iico = sladata%mi(jobs) 
     180         ijco = sladata%mj(jobs) 
    185181             
    186             CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
    187                &                   zglam(:,:,jobs), zgphi(:,:,jobs), & 
    188                &                   zmask(:,:,jobs), zweig, zobsmask ) 
     182         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
     183            &                   zglam(:,:,jobs), zgphi(:,:,jobs), & 
     184            &                   zmask(:,:,jobs), zweig, zobsmask ) 
    189185             
    190             CALL obs_int_h2d( 1, 1,      & 
    191                &              zweig, zbias(:,:,jobs),  zext ) 
    192  
    193             ! adjust mdt with bias field 
    194             sladata(jslano)%rext(jobs,2) = & 
    195                sladata(jslano)%rext(jobs,2) - zext(1) 
     186         CALL obs_int_h2d( 1, 1,      & 
     187            &              zweig, zbias(:,:,jobs),  zext ) 
     188 
     189         ! adjust mdt with bias field 
     190         sladata%rext(jobs,2) = sladata%rext(jobs,2) - zext(1) 
    196191             
    197          END DO 
    198  
    199          DEALLOCATE( & 
    200             & igrdi, & 
    201             & igrdj, & 
    202             & zglam, & 
    203             & zgphi, & 
    204             & zmask, & 
    205             & zbias  & 
    206             & ) 
    207           
    208192      END DO 
    209193 
     194      DEALLOCATE( & 
     195         & igrdi, & 
     196         & igrdj, & 
     197         & zglam, & 
     198         & zgphi, & 
     199         & zmask, & 
     200         & zbias  & 
     201         & ) 
     202          
    210203      CALL wrk_dealloc(jpi,jpj,z_altbias)  
    211204 
Note: See TracChangeset for help on using the changeset viewer.