Changeset 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/OBS
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC/OBS
- Files:
-
- 5 edited
-
diaobs.F90 (modified) (8 diffs)
-
obs_inter_sup.F90 (modified) (4 diffs)
-
obs_read_altbias.F90 (modified) (5 diffs)
-
obs_readmdt.F90 (modified) (7 diffs)
-
obs_rot_vel.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r2733 r3294 16 16 !!---------------------------------------------------------------------- 17 17 !! * Modules used 18 USE wrk_nemo ! Memory Allocation 18 19 USE par_kind ! Precision variables 19 20 USE in_out_manager ! I/O manager … … 1011 1012 & rday 1012 1013 USE oce, ONLY : & ! Ocean dynamics and tracers variables 1013 & tn, & 1014 & sn, & 1014 & tsn, & 1015 1015 & un, vn, & 1016 1016 & sshn 1017 #if defined key_ice_lim1017 #if defined key_lim3 1018 1018 USE ice, ONLY : & ! LIM Ice model variables 1019 1019 & frld 1020 1020 #endif 1021 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 1022 #if ! defined key_ice_lim 1023 USE wrk_nemo, ONLY: frld => wrk_2d_11021 #if defined key_lim2 1022 USE ice_2, ONLY : & ! LIM Ice model variables 1023 & frld 1024 1024 #endif 1025 1025 IMPLICIT NONE … … 1035 1035 INTEGER :: jveloset ! velocity profile data loop variable 1036 1036 INTEGER :: jvar ! Variable number 1037 #if ! defined key_lim2 && ! defined key_lim3 1038 REAL(wp), POINTER, DIMENSION(:,:) :: frld 1039 #endif 1037 1040 CHARACTER(LEN=20) :: datestr=" ",timestr=" " 1038 1041 1039 #if ! defined key_ice_lim 1040 IF(wrk_in_use(2, 1))THEN 1041 CALL ctl_stop('dia_obs : requested workspace array unavailable.') 1042 RETURN 1043 END IF 1042 #if ! defined key_lim2 && ! defined key_lim3 1043 CALL wrk_alloc(jpi,jpj,frld) 1044 1044 #endif 1045 1045 … … 1055 1055 ! No LIM => frld == 0.0_wp 1056 1056 !----------------------------------------------------------------------- 1057 #if ! defined key_ ice_lim1057 #if ! defined key_lim2 && ! defined key_lim3 1058 1058 frld(:,:) = 0.0_wp 1059 1059 #endif … … 1066 1066 DO jprofset = 1, nprofsets 1067 1067 IF ( ld_enact(jprofset) ) THEN 1068 CALL obs_pro_opt( prodatqc(jprofset), & 1069 & kstp, jpi, jpj, jpk, nit000, idaystp, tn, sn,& 1070 & gdept_0, tmask, n1dint, n2dint, & 1068 CALL obs_pro_opt( prodatqc(jprofset), & 1069 & kstp, jpi, jpj, jpk, nit000, idaystp, & 1070 & tsn(:,:,:,jp_tem), tsn(:,:,:,jp_sal), & 1071 & gdept_0, tmask, n1dint, n2dint, & 1071 1072 & kdailyavtypes = endailyavtypes ) 1072 1073 ELSE 1073 CALL obs_pro_opt( prodatqc(jprofset), & 1074 & kstp, jpi, jpj, jpk, nit000, idaystp, tn, sn,& 1074 CALL obs_pro_opt( prodatqc(jprofset), & 1075 & kstp, jpi, jpj, jpk, nit000, idaystp, & 1076 & tsn(:,:,:,jp_tem), tsn(:,:,:,jp_sal), & 1075 1077 & gdept_0, tmask, n1dint, n2dint ) 1076 1078 ENDIF … … 1091 1093 DO jsstset = 1, nsstsets 1092 1094 CALL obs_sst_opt( sstdatqc(jsstset), & 1093 & kstp, jpi, jpj, nit000, t n(:,:,1), &1095 & kstp, jpi, jpj, nit000, tsn(:,:,1,jp_tem), & 1094 1096 & tmask(:,:,1), n2dint ) 1095 1097 END DO … … 1101 1103 ENDIF 1102 1104 1103 #if defined key_ ice_lim1105 #if defined key_lim2 || defined key_lim3 1104 1106 IF ( ln_seaice ) THEN 1105 1107 DO jseaiceset = 1, nseaicesets … … 1121 1123 ENDIF 1122 1124 1123 #if ! defined key_ice_lim 1124 IF(wrk_not_released(2, 1))THEN 1125 CALL ctl_stop('dia_obs : failed to release workspace array.') 1126 END IF 1125 #if ! defined key_lim2 && ! defined key_lim3 1126 CALL wrk_dealloc(jpi,jpj,frld) 1127 1127 #endif 1128 1128 -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90
r2715 r3294 10 10 !!--------------------------------------------------------------------- 11 11 !! * Modules used 12 USE wrk_nemo ! Memory Allocation 12 13 USE par_kind ! Precision variables 13 14 USE dom_oce ! Domain variables … … 105 106 !! ! 08-02 (K. Mogensen) Original code 106 107 !!---------------------------------------------------------------------- 107 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released108 USE wrk_nemo, ONLY: wrk_3d_1109 108 !! 110 109 !! * Arguments … … 122 121 & pgval ! Stencil at each point 123 122 !! * Local declarations 124 REAL(KIND=wp), POINTER, DIMENSION(:,:,:) :: & 125 & zval 123 REAL(KIND=wp), POINTER, DIMENSION(:,:,:) :: zval 126 124 REAL(KIND=wp), DIMENSION(kptsi,kptsj,1,kobs) ::& 127 125 & zgval 128 126 129 127 ! 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) 128 CALL wrk_alloc(jpi,jpj,1,zval) 135 129 136 130 ! Set up local "3D" buffer … … 156 150 157 151 ! '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 152 CALL wrk_dealloc(jpi,jpj,1,zval) 161 153 162 154 END SUBROUTINE obs_int_comm_2d -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90
r2715 r3294 33 33 USE obs_utils ! Various observation tools 34 34 USE obs_inter_sup 35 USE wrk_nemo ! Memory Allocation 35 36 36 37 IMPLICIT NONE … … 67 68 !! * Modules used 68 69 USE iom 69 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released70 USE wrk_nemo, ONLY: z_altbias => wrk_2d_1 ! Array to store the alt bias values71 70 ! 72 71 !! * Arguments … … 102 101 & zglam, & 103 102 & zgphi 103 REAL(wp), POINTER, DIMENSION(:,:) :: z_altbias 104 104 REAL(wp) :: zlam 105 105 REAL(wp) :: zphi … … 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 111 CALL wrk_alloc(jpi,jpj,z_altbias) 115 112 116 113 IF(lwp)WRITE(numout,*) … … 211 208 END DO 212 209 213 IF(wrk_not_released(2, 1))THEN 214 CALL ctl_stop('obs_rea_altbias : failed to release workspace array.') 215 END IF 210 CALL wrk_dealloc(jpi,jpj,z_altbias) 216 211 217 212 END SUBROUTINE obs_rea_altbias -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
r2715 r3294 12 12 !! obs_offset_mdt : Remove the offset between the model MDT and the used one 13 13 !!---------------------------------------------------------------------- 14 USE wrk_nemo ! Memory Allocation 14 15 USE par_kind ! Precision variables 15 16 USE par_oce ! Domain parameters … … 56 57 !!---------------------------------------------------------------------- 57 58 USE iom 58 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released59 USE wrk_nemo, ONLY: z_mdt => wrk_2d_1 ! Array to store the MDT values60 USE wrk_nemo, ONLY: mdtmask => wrk_2d_2 ! Array to store the mask for the MDT61 59 ! 62 60 INTEGER , INTENT(IN) :: kslano ! Number of SLA Products … … 79 77 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zmask, zmdtl, zglam, zgphi 80 78 INTEGER , DIMENSION(:,:,:), ALLOCATABLE :: igrdi, igrdj 79 ! 80 REAL(wp), POINTER, DIMENSION(:,:) :: z_mdt, mdtmask 81 81 82 82 REAL(wp) :: zlam, zphi, zfill, zinfill ! local scalar 83 83 !!---------------------------------------------------------------------- 84 84 85 IF( wrk_in_use(2, 1,2) ) THEN 86 CALL ctl_stop('obs_rea_mdt : requested workspace array unavailable') ; RETURN 87 ENDIF 85 CALL wrk_alloc(jpi,jpj,z_mdt,mdtmask) 88 86 89 87 IF(lwp)WRITE(numout,*) … … 172 170 END DO 173 171 174 IF( wrk_not_released(2, 1,2) ) CALL ctl_stop('obs_rea_mdt: failed to release workspace arrays')172 CALL wrk_dealloc(jpi,jpj,z_mdt,mdtmask) 175 173 ! 176 174 END SUBROUTINE obs_rea_mdt … … 190 188 !! ** Action : 191 189 !!---------------------------------------------------------------------- 192 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released193 USE wrk_nemo, ONLY: zpromsk => wrk_2d_3194 !195 190 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: mdt ! MDT used on the model grid 196 191 REAL(wp) , INTENT(in ) :: zfill … … 198 193 INTEGER :: ji, jj 199 194 REAL(wp) :: zdxdy, zarea, zeta1, zeta2, zcorr_mdt, zcorr_bcketa, zcorr ! local scalar 195 REAL(wp), POINTER, DIMENSION(:,:) :: zpromsk 200 196 CHARACTER(LEN=14), PARAMETER :: cpname = 'obs_offset_mdt' 201 197 !!---------------------------------------------------------------------- 202 198 203 IF( wrk_in_use(2, 3) ) THEN 204 CALL ctl_stop('obs_offset_mdt: requested workspace array unavailable') ; RETURN 205 ENDIF 199 CALL wrk_alloc( jpi,jpj, zpromsk ) 206 200 207 201 ! Initialize the local mask, for domain projection … … 265 259 IF ( nmsshc == 2 ) WRITE(numout,*) ' User defined MSSH correction' 266 260 267 IF( wrk_not_released(2, 3) ) CALL ctl_stop('obs_offset_mdt: failed to release workspace array')261 CALL wrk_dealloc( jpi,jpj, zpromsk ) 268 262 ! 269 263 END SUBROUTINE obs_offset_mdt -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90
r2715 r3294 9 9 !!---------------------------------------------------------------------- 10 10 !! * Modules used 11 USE wrk_nemo ! Memory Allocation 11 12 USE par_kind ! Precision variables 12 13 USE par_oce ! Ocean parameters … … 55 56 !!---------------------------------------------------------------------- 56 57 !! * Modules used 57 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released58 USE wrk_nemo, ONLY: zsingu => wrk_2d_1, zcosgu => wrk_2d_2, &59 zsingv => wrk_2d_3, zcosgv => wrk_2d_460 58 !! * Arguments 61 59 TYPE(obs_prof), INTENT(INOUT) :: profdata ! Profile data to be read … … 85 83 REAL(wp) :: zcos 86 84 REAL(wp), DIMENSION(1) :: zobsmask 85 REAL(wp), POINTER, DIMENSION(:,:) :: zsingu,zcosgu,zsingv,zcosgv 87 86 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 88 87 & igrdiu, & … … 93 92 INTEGER :: jk 94 93 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 94 CALL wrk_alloc(jpi,jpj,zsingu,zcosgu,zsingv,zcosgv) 99 95 100 96 !----------------------------------------------------------------------- … … 229 225 & ) 230 226 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 227 CALL wrk_dealloc(jpi,jpj,zsingu,zcosgu,zsingv,zcosgv) 234 228 235 229 END SUBROUTINE obs_rotvel
Note: See TracChangeset
for help on using the changeset viewer.
