Changeset 6140 for trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90
- Timestamp:
- 2015-12-21T12:35:23+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90
r3294 r6140 50 50 CONTAINS 51 51 52 SUBROUTINE obs_rea_altbias( kslano,sladata, k2dint, bias_file )52 SUBROUTINE obs_rea_altbias( sladata, k2dint, bias_file ) 53 53 !!--------------------------------------------------------------------- 54 54 !! … … 70 70 ! 71 71 !! * Arguments 72 INTEGER, INTENT(IN) :: kslano ! Number of SLA Products 73 TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: & 72 TYPE(obs_surf), INTENT(INOUT) :: & 74 73 & sladata ! SLA data 75 74 INTEGER, INTENT(IN) :: k2dint … … 80 79 CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_rea_altbias' 81 80 82 INTEGER :: jslano ! Data set loop variable83 81 INTEGER :: jobs ! Obs loop variable 84 82 INTEGER :: jpialtbias ! Number of grid point in latitude for the bias … … 144 142 ! Intepolate the bias already on the model grid at the observation point 145 143 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) 185 181 186 187 188 182 CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi, & 183 & zglam(:,:,jobs), zgphi(:,:,jobs), & 184 & zmask(:,:,jobs), zweig, zobsmask ) 189 185 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) 196 191 197 END DO198 199 DEALLOCATE( &200 & igrdi, &201 & igrdj, &202 & zglam, &203 & zgphi, &204 & zmask, &205 & zbias &206 & )207 208 192 END DO 209 193 194 DEALLOCATE( & 195 & igrdi, & 196 & igrdj, & 197 & zglam, & 198 & zgphi, & 199 & zmask, & 200 & zbias & 201 & ) 202 210 203 CALL wrk_dealloc(jpi,jpj,z_altbias) 211 204
Note: See TracChangeset
for help on using the changeset viewer.