Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/OBS
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC/OBS
- Files:
-
- 14 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r2474 r2715 39 39 USE obs_types ! Definitions for observation types 40 40 USE mpp_map ! MPP mapping 41 USE lib_mpp ! For ctl_warn/stop 41 42 42 43 IMPLICIT NONE … … 1026 1027 & frld 1027 1028 #endif 1028 1029 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 1030 #if ! defined key_ice_lim 1031 USE wrk_nemo, ONLY: frld => wrk_2d_1 1032 #endif 1029 1033 IMPLICIT NONE 1030 1034 … … 1032 1036 INTEGER, INTENT(IN) :: kstp ! Current timestep 1033 1037 !! * Local declarations 1034 #if ! defined key_ice_lim1035 REAL(wp), DIMENSION(jpi,jpj) :: frld1036 #endif1037 1038 INTEGER :: idaystp ! Number of timesteps per day 1038 1039 INTEGER :: jprofset ! Profile data set loop variable … … 1044 1045 CHARACTER(LEN=20) :: datestr=" ",timestr=" " 1045 1046 1047 #if ! defined key_ice_lim 1048 IF(wrk_in_use(2, 1))THEN 1049 CALL ctl_stop('dia_obs : requested workspace array unavailable.') 1050 RETURN 1051 END IF 1052 #endif 1053 1046 1054 IF(lwp) THEN 1047 1055 WRITE(numout,*) … … 1121 1129 ENDIF 1122 1130 1131 #if ! defined key_ice_lim 1132 IF(wrk_not_released(2, 1))THEN 1133 CALL ctl_stop('dia_obs : failed to release workspace array.') 1134 END IF 1135 #endif 1136 1123 1137 END SUBROUTINE dia_obs 1124 1138 -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/julian.F90
r2287 r2715 13 13 & wp, & 14 14 & dp 15 USE in_out_manager ! I/O manager 16 15 !USE in_out_manager ! I/O manager 16 USE lib_mpp, ONLY : & 17 & ctl_warn, ctl_stop 18 17 19 IMPLICIT NONE 18 20 -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90
r2474 r2715 33 33 USE obs_const, ONLY : & 34 34 & obfillflt ! Fillvalue 35 35 USE lib_mpp, ONLY : & 36 & ctl_warn, ctl_stop 37 36 38 IMPLICIT NONE 37 39 -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_h2d.F90
r2287 r2715 28 28 & obfillflt ! Fillvalue 29 29 USE obs_utils ! Utility functions 30 30 USE lib_mpp,ONLY : & 31 & ctl_warn, ctl_stop 32 31 33 IMPLICIT NONE 32 34 -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90
r2287 r2715 105 105 !! ! 08-02 (K. Mogensen) Original code 106 106 !!---------------------------------------------------------------------- 107 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 108 USE wrk_nemo, ONLY: wrk_3d_1 109 !! 107 110 !! * Arguments 108 111 INTEGER, INTENT(IN) :: kptsi ! Number of i horizontal points per stencil … … 119 122 & pgval ! Stencil at each point 120 123 !! * Local declarations 121 REAL(KIND=wp), DIMENSION(jpi,jpj,1) :: &124 REAL(KIND=wp), POINTER, DIMENSION(:,:,:) :: & 122 125 & zval 123 126 REAL(KIND=wp), DIMENSION(kptsi,kptsj,1,kobs) ::& 124 127 & zgval 125 128 129 ! Check workspace array and set-up pointer 130 IF(wrk_in_use(3, 1))THEN 131 CALL ctl_stop('obs_int_comm_2d : requested workspace array unavailable.') 132 RETURN 133 END IF 134 zval => wrk_3d_1(:,:,1:1) 135 126 136 ! Set up local "3D" buffer 127 137 … … 144 154 145 155 pgval(:,:,:) = zgval(:,:,1,:) 156 157 ! 'Release' workspace array back to pool 158 IF(wrk_not_released(3, 1))THEN 159 CALL ctl_stop('obs_int_comm_2d : failed to release workspace array.') 160 END IF 146 161 147 162 END SUBROUTINE obs_int_comm_2d -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
r2576 r2715 38 38 & glamt, glamu, glamv, & 39 39 & gphit, gphiu, gphiv 40 USE lib_mpp, ONLY : & 41 & ctl_warn, ctl_stop 40 42 41 43 IMPLICIT NONE -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
r2287 r2715 27 27 USE obs_inter_sup ! Interpolation support 28 28 USE obs_oper ! Observation operators 29 USE lib_mpp, ONLY : & 30 & ctl_warn, ctl_stop 29 31 30 32 IMPLICIT NONE -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90
r2287 r2715 29 29 obs_mpp_sum_integers 30 30 USE obs_fbm ! Obs feedback format 31 USE lib_mpp, ONLY : & 32 & ctl_warn, ctl_stop 31 33 32 34 IMPLICIT NONE -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90
r2287 r2715 67 67 !! * Modules used 68 68 USE iom 69 69 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 70 USE wrk_nemo, ONLY: z_altbias => wrk_2d_1 ! Array to store the alt bias values 71 ! 70 72 !! * Arguments 71 73 INTEGER, INTENT(IN) :: kslano ! Number of SLA Products … … 90 92 INTEGER :: i_var_id 91 93 92 REAL(wp), DIMENSION(jpi,jpj) :: &93 & z_altbias ! Array to store the alt bias values94 94 REAL(wp), DIMENSION(1) :: & 95 95 & zext, & … … 109 109 INTEGER :: numaltbias 110 110 111 IF(wrk_in_use(2, 1))THEN 112 CALL ctl_stop('obs_rea_altbias : requested workspace array unavailable.') 113 RETURN 114 END IF 115 111 116 IF(lwp)WRITE(numout,*) 112 117 IF(lwp)WRITE(numout,*) ' obs_rea_altbias : ' … … 206 211 END DO 207 212 213 IF(wrk_not_released(2, 1))THEN 214 CALL ctl_stop('obs_rea_altbias : failed to release workspace array.') 215 END IF 216 208 217 END SUBROUTINE obs_rea_altbias 209 218 -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
r2287 r2715 26 26 USE obs_oper ! Observation operators 27 27 USE obs_prof_io ! Profile files I/O (non-FB files) 28 USE lib_mpp ! For ctl_warn/stop 28 29 29 30 IMPLICIT NONE -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90
r2287 r2715 26 26 USE obs_oper ! Observation operators 27 27 USE obs_vel_io ! Velocity profile files I/O (non-FB files) 28 USE lib_mpp ! For ctl_warn/stop 28 29 29 30 IMPLICIT NONE -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
r2287 r2715 4 4 !! Observation diagnostics: Read the MDT for SLA data (skeleton for now) 5 5 !!====================================================================== 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 43 28 44 29 IMPLICIT NONE 45 46 !! * Routine accessibility47 30 PRIVATE 48 49 INTEGER, PUBLIC :: nmsshc = 1 ! MDT correction scheme50 REAL(wp), PUBLIC :: mdtcorr = 1.61 ! User specified MDT correction51 REAL(wp), PUBLIC :: mdtcutoff = 65.0 ! MDT cutoff for computed correction 52 PUBLIC obs_rea_mdt ! Read the MDT53 PUBLIC obs_offset_mdt ! Remove the offset between the model MDT and the54 ! used one31 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 55 38 56 39 !!---------------------------------------------------------------------- 57 40 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 58 41 !! $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 !!---------------------------------------------------------------------- 62 44 CONTAINS 63 45 … … 72 54 !! 73 55 !! ** 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 !!---------------------------------------------------------------------- 82 57 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 122 81 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 131 88 132 89 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' 134 91 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 149 97 150 98 ! Read in the fill value … … 156 104 i_stat = nf90_close( nummdt ) 157 105 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 165 110 END WHERE 166 111 167 112 ! 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 ) 170 114 171 115 ! Intepolate the MDT already on the model grid at the observation point 172 116 173 117 DO jslano = 1, kslano 174 175 118 ALLOCATE( & 176 119 & igrdi(2,2,sladata(jslano)%nsurf), & … … 195 138 END DO 196 139 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 ) 205 144 206 145 DO jobs = 1, sladata(jslano)%nsurf … … 213 152 & zmask(:,:,jobs), zweig, zobsmask ) 214 153 215 CALL obs_int_h2d( 1, 1, & 216 & zweig, zmdtl(:,:,jobs), zext ) 154 CALL obs_int_h2d( 1, 1, zweig, zmdtl(:,:,jobs), zext ) 217 155 218 156 sladata(jslano)%rext(jobs,2) = zext(1) 219 157 220 158 ! mark any masked data with a QC flag 221 IF ( zobsmask(1) == 0 )sladata(jslano)%nqc(jobs) = 11159 IF( zobsmask(1) == 0 ) sladata(jslano)%nqc(jobs) = 11 222 160 223 161 END DO … … 234 172 END DO 235 173 174 IF( wrk_not_released(2, 1,2) ) CALL ctl_stop('obs_rea_mdt: failed to release workspace arrays') 175 ! 236 176 END SUBROUTINE obs_rea_mdt 237 177 178 238 179 SUBROUTINE obs_offset_mdt( mdt, zfill ) 239 240 180 !!--------------------------------------------------------------------- 241 181 !! … … 249 189 !! 250 190 !! ** 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 278 207 ! Initialize the local mask, for domain projection 279 208 ! Also exclude mdt points which are set to missing data … … 304 233 END DO 305 234 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 ) 309 238 310 zcorr_mdt = zeta1 / zarea311 zcorr_bcketa 239 zcorr_mdt = zeta1 / zarea 240 zcorr_bcketa = zeta2 / zarea 312 241 313 242 ! Define correction term … … 317 246 ! Correct spatial mean of the MSSH 318 247 319 IF ( nmsshc == 1 )mdt(:,:) = mdt(:,:) - zcorr248 IF( nmsshc == 1 ) mdt(:,:) = mdt(:,:) - zcorr 320 249 321 250 ! User defined value : 1.6 m for the Rio MDT compared to ORCA2 MDT 322 251 323 IF ( nmsshc == 2 )mdt(:,:) = mdt(:,:) - mdtcorr252 IF( nmsshc == 2 ) mdt(:,:) = mdt(:,:) - mdtcorr 324 253 325 254 IF(lwp) THEN … … 330 259 WRITE(numout,*) ' zcorr = ', zcorr 331 260 WRITE(numout,*) ' nmsshc = ', nmsshc 332 WRITE(numout,*)333 261 ENDIF 334 262 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 ! 343 269 END SUBROUTINE obs_offset_mdt 344 270 271 !!====================================================================== 345 272 END MODULE obs_readmdt -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90
r2287 r2715 55 55 !!---------------------------------------------------------------------- 56 56 !! * Modules used 57 57 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 58 USE wrk_nemo, ONLY: zsingu => wrk_2d_1, zcosgu => wrk_2d_2, & 59 zsingv => wrk_2d_3, zcosgv => wrk_2d_4 58 60 !! * Arguments 59 61 TYPE(obs_prof), INTENT(INOUT) :: profdata ! Profile data to be read … … 63 65 & pv 64 66 !! * Local declarations 65 REAL(wp), DIMENSION(jpi,jpj) :: &66 & zsingu, &67 & zcosgu, &68 & zsingv, &69 & zcosgv70 67 REAL(wp), DIMENSION(2,2,1) :: zweig 71 68 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & … … 96 93 INTEGER :: jk 97 94 95 IF(wrk_in_use(2, 1,2,3,4))THEN 96 CALL ctl_stop('obs_rotvel : requested workspace arrays unavailable.') 97 RETURN 98 END IF 99 98 100 !----------------------------------------------------------------------- 99 101 ! Allocate data for message parsing and interpolation … … 227 229 & ) 228 230 231 IF(wrk_not_released(2, 1,2,3,4))THEN 232 CALL ctl_stop('obs_rotvel : failed to release workspace arrays.') 233 END IF 234 229 235 END SUBROUTINE obs_rotvel 230 236 -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_utils.F90
r2287 r2715 19 19 & i8 20 20 USE in_out_manager ! I/O manager 21 21 USE lib_mpp ! For ctl_warn/stop 22 22 23 IMPLICIT NONE 23 24
Note: See TracChangeset
for help on using the changeset viewer.