- Timestamp:
- 2011-11-25T16:31:02+01:00 (13 years ago)
- Location:
- branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/OBS
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r2977 r3183 16 16 !!---------------------------------------------------------------------- 17 17 !! * Modules used 18 USE wrk_nemo_2 ! Memory Allocation 18 19 USE par_kind ! Precision variables 19 20 USE in_out_manager ! I/O manager … … 1018 1019 & frld 1019 1020 #endif 1020 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released1021 #if ! defined key_ice_lim1022 USE wrk_nemo, ONLY: frld => wrk_2d_11023 #endif1024 1021 IMPLICIT NONE 1025 1022 … … 1034 1031 INTEGER :: jveloset ! velocity profile data loop variable 1035 1032 INTEGER :: jvar ! Variable number 1033 #if ! defined key_ice_lim 1034 REAL(wp), POINTER, DIMENSION(:,:) :: frld 1035 #endif 1036 1036 CHARACTER(LEN=20) :: datestr=" ",timestr=" " 1037 1037 1038 1038 #if ! defined key_ice_lim 1039 IF(wrk_in_use(2, 1))THEN 1040 CALL ctl_stop('dia_obs : requested workspace array unavailable.') 1041 RETURN 1042 END IF 1039 CALL wrk_alloc(jpi,jpj,frld) 1043 1040 #endif 1044 1041 … … 1123 1120 1124 1121 #if ! defined key_ice_lim 1125 IF(wrk_not_released(2, 1))THEN 1126 CALL ctl_stop('dia_obs : failed to release workspace array.') 1127 END IF 1122 CALL wrk_dealloc(jpi,jpj,frld) 1128 1123 #endif 1129 1124 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90
r2715 r3183 10 10 !!--------------------------------------------------------------------- 11 11 !! * Modules used 12 USE wrk_nemo_2 ! 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 … … 128 127 129 128 ! 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) 129 CALL wrk_alloc(jpi,jpj,1,zval) 135 130 136 131 ! Set up local "3D" buffer … … 156 151 157 152 ! '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 153 CALL wrk_dealloc(jpi,jpj,1,zval) 161 154 162 155 END SUBROUTINE obs_int_comm_2d -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90
r2715 r3183 33 33 USE obs_utils ! Various observation tools 34 34 USE obs_inter_sup 35 USE wrk_nemo_2 ! 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(:,:) :: & 104 & z_altbias 104 105 REAL(wp) :: zlam 105 106 REAL(wp) :: zphi … … 109 110 INTEGER :: numaltbias 110 111 111 IF(wrk_in_use(2, 1))THEN 112 CALL ctl_stop('obs_rea_altbias : requested workspace array unavailable.') 113 RETURN 114 END IF 112 CALL wrk_alloc(jpi,jpj,z_altbias) 115 113 116 114 IF(lwp)WRITE(numout,*) … … 211 209 END DO 212 210 213 IF(wrk_not_released(2, 1))THEN 214 CALL ctl_stop('obs_rea_altbias : failed to release workspace array.') 215 END IF 211 CALL wrk_dealloc(jpi,jpj,z_altbias) 216 212 217 213 END SUBROUTINE obs_rea_altbias -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
r2715 r3183 12 12 !! obs_offset_mdt : Remove the offset between the model MDT and the used one 13 13 !!---------------------------------------------------------------------- 14 USE wrk_nemo_2 ! 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 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90
r2715 r3183 9 9 !!---------------------------------------------------------------------- 10 10 !! * Modules used 11 USE wrk_nemo_2 ! 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.