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 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90 – NEMO

Ignore:
Timestamp:
2011-03-30T17:58:35+02:00 (13 years ago)
Author:
rblod
Message:

First attempt to put dynamic allocation on the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90

    r2287 r2715  
    44   !! Observation diagnostics: Read the MDT for SLA data (skeleton for now) 
    55   !!====================================================================== 
    6  
    7    !!---------------------------------------------------------------------- 
    8    !!   obs_rea_mdt : Driver for reading MDT 
    9    !!---------------------------------------------------------------------- 
    10  
    11    !! * Modules used    
    12    USE par_kind, ONLY : &       ! Precision variables 
    13       & wp, & 
    14       & dp, & 
    15       & sp 
    16    USE par_oce, ONLY : &        ! Domain parameters 
    17       & jpi, & 
    18       & jpj, & 
    19       & jpim1 
    20    USE in_out_manager, ONLY : & ! I/O manager 
    21       & lwp,    & 
    22       & numout  
    23    USE obs_surf_def             ! Surface observation definitions 
    24    USE dom_oce, ONLY : &        ! Domain variables 
    25       & tmask, & 
    26       & tmask_i, & 
    27       & e1t,   & 
    28       & e2t,   & 
    29       & gphit, & 
    30       & glamt 
    31    USE obs_const, ONLY : & 
    32       & obfillflt              ! Fillvalue 
    33    USE oce, ONLY : &           ! Model variables 
    34       & sshn 
    35    USE obs_inter_sup           ! Interpolation support routines 
    36    USE obs_inter_h2d           ! 2D interpolation 
    37    USE obs_utils               ! Various observation tools 
    38    USE lib_mpp, only: &        ! MPP routines 
    39       & lk_mpp, & 
    40       & mpp_sum 
    41    USE iom_nf90    
    42    USE netcdf                   ! NetCDF library 
     6   !! History :      ! 2007-03 (K. Mogensen) Initial skeleton version 
     7   !!                ! 2007-04 (E. Remy) migration and improvement from OPAVAR 
     8   !!---------------------------------------------------------------------- 
     9 
     10   !!---------------------------------------------------------------------- 
     11   !!   obs_rea_mdt    : Driver for reading MDT 
     12   !!   obs_offset_mdt : Remove the offset between the model MDT and the used one 
     13   !!---------------------------------------------------------------------- 
     14   USE par_kind         ! Precision variables 
     15   USE par_oce          ! Domain parameters 
     16   USE in_out_manager   ! I/O manager 
     17   USE obs_surf_def     ! Surface observation definitions 
     18   USE obs_inter_sup    ! Interpolation support routines 
     19   USE obs_inter_h2d    ! 2D interpolation 
     20   USE obs_utils        ! Various observation tools 
     21   USE iom_nf90         ! IOM NetCDF 
     22   USE netcdf           ! NetCDF library 
     23   USE lib_mpp          ! MPP library 
     24   USE dom_oce, ONLY : &                  ! Domain variables 
     25      &                    tmask, tmask_i, e1t, e2t, gphit, glamt 
     26   USE obs_const, ONLY :   obfillflt      ! Fillvalue 
     27   USE oce      , ONLY :   sshn           ! Model variables 
    4328 
    4429   IMPLICIT NONE 
    45  
    46    !! * Routine accessibility 
    4730   PRIVATE 
    48  
    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 
    52    PUBLIC obs_rea_mdt     ! Read the MDT 
    53    PUBLIC obs_offset_mdt  ! Remove the offset between the model MDT and the  
    54                           ! used one 
     31    
     32   PUBLIC   obs_rea_mdt     ! called by ? 
     33   PUBLIC   obs_offset_mdt  ! called by ? 
     34 
     35   INTEGER , PUBLIC ::   nmsshc    = 1         ! MDT correction scheme 
     36   REAL(wp), PUBLIC ::   mdtcorr   = 1.61_wp   ! User specified MDT correction 
     37   REAL(wp), PUBLIC ::   mdtcutoff = 65.0_wp   ! MDT cutoff for computed correction 
    5538 
    5639   !!---------------------------------------------------------------------- 
    5740   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5841   !! $Id$ 
    59    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    60    !!---------------------------------------------------------------------- 
    61  
     42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     43   !!---------------------------------------------------------------------- 
    6244CONTAINS 
    6345 
     
    7254      !! 
    7355      !! ** Action  :  
    74       !! 
    75       !! References : 
    76       !! 
    77       !! History :   
    78       !!      ! :  2007-03 (K. Mogensen) Initial skeleton version 
    79       !!      ! :  2007-04 (E. Remy) migration and improvement from OPAVAR 
    80       !!---------------------------------------------------------------------- 
    81       !! * Modules used 
     56      !!---------------------------------------------------------------------- 
    8257      USE iom 
    83  
    84       !! * Arguments 
    85       INTEGER, INTENT(IN) :: kslano          ! Number of SLA Products 
    86       TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: & 
    87          & sladata       ! SLA data 
    88       INTEGER, INTENT(IN) :: k2dint 
    89  
    90       !! * Local declarations 
    91  
    92       CHARACTER(LEN=12), PARAMETER :: & 
    93          & cpname = 'obs_rea_mdt' 
    94       CHARACTER(LEN=20), PARAMETER :: & 
    95          & mdtname = 'slaReferenceLevel.nc' 
    96  
    97       INTEGER :: jslano      ! Data set loop variable 
    98       INTEGER :: jobs        ! Obs loop variable 
    99       INTEGER :: jpimdt      ! Number of grid point in latitude for the MDT 
    100       INTEGER :: jpjmdt      ! Number of grid point in longitude for the MDT 
    101       INTEGER :: iico        ! Grid point indicies 
    102       INTEGER :: ijco  
    103       INTEGER :: i_nx_id     ! Index to read the NetCDF file 
    104       INTEGER :: i_ny_id     !  
    105       INTEGER :: i_file_id   !  
    106       INTEGER :: i_var_id 
    107       INTEGER :: i_stat 
    108  
    109       REAL(wp), DIMENSION(jpi,jpj) :: &  
    110          & z_mdt,       &  ! Array to store the MDT values 
    111          & mdtmask         ! Array to store the mask for the MDT 
    112       REAL(wp), DIMENSION(1) :: & 
    113          & zext, & 
    114          & zobsmask 
    115       REAL(wp), DIMENSION(2,2,1) :: & 
    116          & zweig 
    117       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    118          & zmask, & 
    119          & zmdtl, & 
    120          & zglam, & 
    121          & zgphi 
     58      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     59      USE wrk_nemo, ONLY:   z_mdt   => wrk_2d_1   ! Array to store the MDT values 
     60      USE wrk_nemo, ONLY:   mdtmask => wrk_2d_2   ! Array to store the mask for the MDT 
     61      ! 
     62      INTEGER                          , INTENT(IN)    ::   kslano    ! Number of SLA Products 
     63      TYPE(obs_surf), DIMENSION(kslano), INTENT(inout) ::   sladata   ! SLA data 
     64      INTEGER                          , INTENT(in)    ::   k2dint    ! ? 
     65      ! 
     66      CHARACTER(LEN=12), PARAMETER ::   cpname  = 'obs_rea_mdt' 
     67      CHARACTER(LEN=20), PARAMETER ::   mdtname = 'slaReferenceLevel.nc' 
     68 
     69      INTEGER ::   jslano              ! Data set loop variable 
     70      INTEGER ::   jobs                ! Obs loop variable 
     71      INTEGER ::   jpimdt, jpjmdt      ! Number of grid point in lat/lon for the MDT 
     72      INTEGER ::   iico, ijco          ! Grid point indicies 
     73      INTEGER ::   i_nx_id, i_ny_id, i_file_id, i_var_id, i_stat 
     74      INTEGER ::   nummdt 
     75      ! 
     76      REAL(wp), DIMENSION(1)     ::   zext, zobsmask 
     77      REAL(wp), DIMENSION(2,2,1) ::   zweig 
     78      ! 
     79      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   zmask, zmdtl, zglam, zgphi 
     80      INTEGER , DIMENSION(:,:,:), ALLOCATABLE ::   igrdi, igrdj 
    12281          
    123       REAL(wp) :: zlam 
    124       REAL(wp) :: zphi 
    125       REAL(wp) :: zfill 
    126       REAL(sp) :: zinfill 
    127       INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
    128          & igrdi, & 
    129          & igrdj 
    130       INTEGER :: nummdt 
     82      REAL(wp) :: zlam, zphi, zfill, zinfill    ! local scalar 
     83      !!---------------------------------------------------------------------- 
     84 
     85      IF( wrk_in_use(2, 1,2) ) THEN 
     86         CALL ctl_stop('obs_rea_mdt : requested workspace array unavailable')   ;   RETURN 
     87      ENDIF 
    13188 
    13289      IF(lwp)WRITE(numout,*)  
    133       IF(lwp)WRITE(numout,*) ' obs_rea_mdt : ' 
     90      IF(lwp)WRITE(numout,*) ' obs_rea_mdt : Read MDT for referencing altimeter anomalies' 
    13491      IF(lwp)WRITE(numout,*) ' ------------- ' 
    135       IF(lwp)WRITE(numout,*) '   Read MDT for referencing altimeter', & 
    136          &                   '   anomalies' 
    137  
    138       ! Open the file 
    139        
    140       CALL iom_open( mdtname, nummdt ) 
    141        
    142       ! Get the MDT data 
    143  
    144       CALL iom_get( nummdt, jpdom_data, 'sossheig', z_mdt(:,:), 1 ) 
    145  
    146       ! Close the file 
    147  
    148       CALL iom_close(nummdt)      
     92 
     93      CALL iom_open( mdtname, nummdt )       ! Open the file 
     94      !                                      ! Get the MDT data 
     95      CALL iom_get ( nummdt, jpdom_data, 'sossheig', z_mdt(:,:), 1 ) 
     96      CALL iom_close(nummdt)                 ! Close the file 
    14997       
    15098      ! Read in the fill value 
     
    156104      i_stat = nf90_close( nummdt ) 
    157105 
    158 ! setup mask based on tmask and MDT mask 
    159 ! set mask to 0 where the MDT is set to fillvalue 
    160  
    161       WHERE(z_mdt(:,:) /= zfill) 
    162          mdtmask(:,:)=tmask(:,:,1) 
    163       ELSEWHERE 
    164          mdtmask(:,:)=0 
     106      ! setup mask based on tmask and MDT mask 
     107      ! set mask to 0 where the MDT is set to fillvalue 
     108      WHERE(z_mdt(:,:) /= zfill)   ;   mdtmask(:,:) = tmask(:,:,1) 
     109      ELSE WHERE                   ;   mdtmask(:,:) = 0 
    165110      END WHERE 
    166111 
    167112      ! Remove the offset between the MDT used with the sla and the model MDT 
    168  
    169       IF ( nmsshc == 1 .OR. nmsshc == 2 ) CALL obs_offset_mdt( z_mdt, zfill ) 
     113      IF( nmsshc == 1 .OR. nmsshc == 2 )   CALL obs_offset_mdt( z_mdt, zfill ) 
    170114 
    171115      ! Intepolate the MDT already on the model grid at the observation point 
    172116   
    173117      DO jslano = 1, kslano 
    174  
    175118         ALLOCATE( & 
    176119            & igrdi(2,2,sladata(jslano)%nsurf), & 
     
    195138         END DO 
    196139 
    197          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 
    198             &                  igrdi, igrdj, glamt, zglam ) 
    199          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 
    200             &                  igrdi, igrdj, gphit, zgphi ) 
    201          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 
    202             &                  igrdi, igrdj, mdtmask, zmask ) 
    203          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 
    204             &                  igrdi, igrdj, z_mdt, zmdtl ) 
     140         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, glamt  , zglam ) 
     141         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, gphit  , zgphi ) 
     142         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, mdtmask, zmask ) 
     143         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, z_mdt  , zmdtl ) 
    205144 
    206145         DO jobs = 1, sladata(jslano)%nsurf 
     
    213152               &                   zmask(:,:,jobs), zweig, zobsmask ) 
    214153             
    215             CALL obs_int_h2d( 1, 1,      & 
    216                    &              zweig, zmdtl(:,:,jobs),  zext ) 
     154            CALL obs_int_h2d( 1, 1, zweig, zmdtl(:,:,jobs),  zext ) 
    217155  
    218156            sladata(jslano)%rext(jobs,2) = zext(1) 
    219157 
    220158! mark any masked data with a QC flag 
    221             IF ( zobsmask(1) == 0 ) sladata(jslano)%nqc(jobs) = 11 
     159            IF( zobsmask(1) == 0 )  sladata(jslano)%nqc(jobs) = 11 
    222160 
    223161         END DO 
     
    234172      END DO 
    235173 
     174      IF( wrk_not_released(2, 1,2) )   CALL ctl_stop('obs_rea_mdt: failed to release workspace arrays') 
     175      ! 
    236176   END SUBROUTINE obs_rea_mdt 
    237177 
     178 
    238179   SUBROUTINE obs_offset_mdt( mdt, zfill ) 
    239  
    240180      !!--------------------------------------------------------------------- 
    241181      !! 
     
    249189      !! 
    250190      !! ** Action  :  
    251       !! 
    252       !! References : 
    253       !! 
    254       !! History :   
    255       !!      ! :  2007-04 (E. Remy) migration from OPAVAR 
    256       !!---------------------------------------------------------------------- 
    257       !! * Modules used 
    258  
    259       !! * Arguments 
    260       REAL(wp), DIMENSION(jpi,jpj), INTENT(INOUT) :: & 
    261          & mdt           ! MDT used on the model grid 
    262       REAL(wp), INTENT(IN) :: zfill  
    263  
    264       !! * Local declarations  
    265       REAL(wp) :: zdxdy 
    266       REAL(wp) :: zarea 
    267       REAL(wp) :: zeta1 
    268       REAL(wp) :: zeta2 
    269       REAL(wp) :: zcorr_mdt   
    270       REAL(wp) :: zcorr_bcketa 
    271       REAL(wp) :: zcorr 
    272       REAL(wp), DIMENSION(jpi,jpj) :: zpromsk 
    273       INTEGER :: jj 
    274       INTEGER :: ji 
    275       CHARACTER(LEN=14), PARAMETER :: & 
    276          & cpname = 'obs_offset_mdt' 
    277     
     191      !!---------------------------------------------------------------------- 
     192      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     193      USE wrk_nemo, ONLY:   zpromsk => wrk_2d_3 
     194      ! 
     195      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   mdt     ! MDT used on the model grid 
     196      REAL(wp)                    , INTENT(in   ) ::   zfill  
     197      !  
     198      INTEGER  :: ji, jj 
     199      REAL(wp) :: zdxdy, zarea, zeta1, zeta2, zcorr_mdt, zcorr_bcketa, zcorr     ! local scalar 
     200      CHARACTER(LEN=14), PARAMETER ::   cpname = 'obs_offset_mdt' 
     201      !!---------------------------------------------------------------------- 
     202 
     203      IF( wrk_in_use(2, 3) ) THEN 
     204         CALL ctl_stop('obs_offset_mdt: requested workspace array unavailable')   ;   RETURN 
     205      ENDIF 
     206 
    278207      !  Initialize the local mask, for domain projection  
    279208      !  Also exclude mdt points which are set to missing data 
     
    304233      END DO 
    305234 
    306       IF( lk_mpp) CALL mpp_sum( zeta1 ) 
    307       IF( lk_mpp) CALL mpp_sum( zeta2 ) 
    308       IF( lk_mpp) CALL mpp_sum( zarea ) 
     235      IF( lk_mpp)   CALL mpp_sum( zeta1 ) 
     236      IF( lk_mpp)   CALL mpp_sum( zeta2 ) 
     237      IF( lk_mpp)   CALL mpp_sum( zarea ) 
    309238       
    310       zcorr_mdt = zeta1 / zarea 
    311       zcorr_bcketa  = zeta2 / zarea 
     239      zcorr_mdt    = zeta1 / zarea 
     240      zcorr_bcketa = zeta2 / zarea 
    312241 
    313242      !  Define correction term 
     
    317246      !  Correct spatial mean of the MSSH 
    318247 
    319       IF ( nmsshc == 1 ) mdt(:,:) = mdt(:,:) - zcorr   
     248      IF( nmsshc == 1 )  mdt(:,:) = mdt(:,:) - zcorr   
    320249 
    321250      ! User defined value : 1.6 m for the Rio MDT compared to ORCA2 MDT 
    322251 
    323       IF ( nmsshc == 2 ) mdt(:,:) = mdt(:,:) - mdtcorr 
     252      IF( nmsshc == 2 )  mdt(:,:) = mdt(:,:) - mdtcorr 
    324253 
    325254      IF(lwp) THEN 
     
    330259         WRITE(numout,*) '               zcorr         = ', zcorr 
    331260         WRITE(numout,*) '               nmsshc        = ', nmsshc 
    332          WRITE(numout,*)  
    333261      ENDIF 
    334262 
    335       IF ( nmsshc == 0 ) WRITE(numout,*) & 
    336          &                 '           MSSH correction is not applied' 
    337       IF ( nmsshc == 1 ) WRITE(numout,*) & 
    338          &                 '           MSSH correction is applied' 
    339       IF ( nmsshc == 2 ) WRITE(numout,*) & 
    340          &                 '           User defined MSSH correction'  
    341  
    342  
     263      IF ( nmsshc == 0 ) WRITE(numout,*) '           MSSH correction is not applied' 
     264      IF ( nmsshc == 1 ) WRITE(numout,*) '           MSSH correction is applied' 
     265      IF ( nmsshc == 2 ) WRITE(numout,*) '           User defined MSSH correction'  
     266 
     267      IF( wrk_not_released(2, 3) )   CALL ctl_stop('obs_offset_mdt: failed to release workspace array') 
     268      ! 
    343269   END SUBROUTINE obs_offset_mdt 
    344270  
     271   !!====================================================================== 
    345272END MODULE obs_readmdt 
Note: See TracChangeset for help on using the changeset viewer.