Changeset 2125 for branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC/fldread.F90
- Timestamp:
- 2010-09-27T12:22:04+02:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC/fldread.F90
r2051 r2125 78 78 INTEGER, DIMENSION(:,:,:), POINTER :: data_jpj ! array of source integers 79 79 REAL(wp), DIMENSION(:,:,:), POINTER :: data_wgt ! array of weights on model grid 80 REAL(wp), DIMENSION(:,:,:), POINTER :: fly_dta ! array of values on input grid81 REAL(wp), DIMENSION(:,:,:), POINTER :: col2 ! temporary array for reading in columns80 REAL(wp), DIMENSION(:,:,:), POINTER :: fly_dta ! array of values on input grid 81 REAL(wp), DIMENSION(:,:,:), POINTER :: col2 ! temporary array for reading in columns 82 82 END TYPE WGT 83 83 … … 146 146 !CDIR COLLAPSE 147 147 sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) 148 sd(jf)%rotn(1) 148 sd(jf)%rotn(1) = sd(jf)%rotn(2) 149 149 ENDIF 150 150 … … 209 209 IF( LEN(TRIM(sd(jf)%wgtname)) > 0 ) THEN 210 210 CALL wgt_list( sd(jf), kw ) 211 ipk = SIZE(sd(jf)%fdta,3) 212 CALL fld_interp( sd(jf)%num, sd(jf)%clvar , kw , ipk, sd(jf)%fdta(:,:,:,2) , sd(jf)%nrec_a(1) ) 211 ipk = SIZE(sd(jf)%fnow,3) 212 IF( sd(jf)%ln_tint ) THEN 213 CALL fld_interp( sd(jf)%num, sd(jf)%clvar , kw , ipk, sd(jf)%fdta(:,:,:,2) , sd(jf)%nrec_a(1) ) 214 ELSE 215 CALL fld_interp( sd(jf)%num, sd(jf)%clvar , kw , ipk, sd(jf)%fnow(:,:,:) , sd(jf)%nrec_a(1) ) 216 ENDIF 213 217 ELSE 214 SELECT CASE( SIZE(sd(jf)%fdta,3) ) 215 CASE(1) 216 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,1,2), sd(jf)%nrec_a(1) ) 218 SELECT CASE( SIZE(sd(jf)%fnow,3) ) 219 CASE(1) 220 IF( sd(jf)%ln_tint ) THEN 221 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,1,2), sd(jf)%nrec_a(1) ) 222 ELSE 223 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fnow(:,:,1) , sd(jf)%nrec_a(1) ) 224 ENDIF 217 225 CASE(jpk) 218 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,:,2), sd(jf)%nrec_a(1) ) 226 IF( sd(jf)%ln_tint ) THEN 227 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,:,2), sd(jf)%nrec_a(1) ) 228 ELSE 229 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fnow(:,:,:) , sd(jf)%nrec_a(1) ) 230 ENDIF 219 231 END SELECT 220 232 ENDIF … … 251 263 IF( kf > 0 ) THEN 252 264 !! fields jf,kf are two components which need to be rotated together 253 DO nf = 1,2 265 IF( sd(jf)%ln_tint )THEN 266 DO nf = 1,2 267 !! check each time level of this pair 268 IF( .NOT. sd(jf)%rotn(nf) .AND. .NOT. sd(kf)%rotn(nf) ) THEN 269 utmp(:,:) = 0.0 270 vtmp(:,:) = 0.0 271 ! 272 ipk = SIZE( sd(kf)%fnow(:,:,:) ,3 ) 273 DO jk = 1,ipk 274 CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->i', utmp(:,:) ) 275 CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->j', vtmp(:,:) ) 276 sd(jf)%fdta(:,:,jk,nf) = utmp(:,:) 277 sd(kf)%fdta(:,:,jk,nf) = vtmp(:,:) 278 ENDDO 279 ! 280 sd(jf)%rotn(nf) = .TRUE. 281 sd(kf)%rotn(nf) = .TRUE. 282 IF( lwp .AND. kt == nit000 ) & 283 WRITE(numout,*) 'fld_read: vector pair (', & 284 TRIM(sd(jf)%clvar),',',TRIM(sd(kf)%clvar), & 285 ') rotated on to model grid' 286 ENDIF 287 END DO 288 ELSE 254 289 !! check each time level of this pair 255 290 IF( .NOT. sd(jf)%rotn(nf) .AND. .NOT. sd(kf)%rotn(nf) ) THEN … … 257 292 vtmp(:,:) = 0.0 258 293 ! 259 ipk = SIZE( sd(kf)%f dta(:,:,:,nf) ,3 )294 ipk = SIZE( sd(kf)%fnow(:,:,:) ,3 ) 260 295 DO jk = 1,ipk 261 CALL rot_rep( sd(jf)%f dta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->i', utmp(:,:) )262 CALL rot_rep( sd(jf)%f dta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->j', vtmp(:,:) )263 sd(jf)%f dta(:,:,jk,nf) = utmp(:,:)264 sd(kf)%f dta(:,:,jk,nf) = vtmp(:,:)265 END 296 CALL rot_rep( sd(jf)%fnow(:,:,jk),sd(kf)%fnow(:,:,jk),'T', 'en->i', utmp(:,:) ) 297 CALL rot_rep( sd(jf)%fnow(:,:,jk),sd(kf)%fnow(:,:,jk),'T', 'en->j', vtmp(:,:) ) 298 sd(jf)%fnow(:,:,jk) = utmp(:,:) 299 sd(kf)%fnow(:,:,jk) = vtmp(:,:) 300 ENDDO 266 301 ! 267 302 sd(jf)%rotn(nf) = .TRUE. … … 272 307 ') rotated on to model grid' 273 308 ENDIF 274 END DO309 ENDIF 275 310 ENDIF 276 311 ENDIF … … 304 339 ENDIF 305 340 !CDIR COLLAPSE 306 sd(jf)%fnow(:,:,:) = sd(jf)%fdta(:,:,:,2) ! piecewise constant field307 308 341 ENDIF 309 342 ! … … 405 438 IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 406 439 CALL wgt_list( sdjf, kwgt ) 407 ipk = SIZE(sdjf%fdta,3) 408 CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, ipk, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 440 ipk = SIZE(sdjf%fnow,3) 441 IF( sdjf%ln_tint ) THEN 442 CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, ipk, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 443 ELSE 444 CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, ipk, sdjf%fnow(:,:,:) , sdjf%nrec_a(1) ) 445 ENDIF 409 446 ELSE 410 SELECT CASE ( SIZE(sdjf%fdta,3) ) 447 write(narea+200,*)' sdjf%ln_tint SIZE(sdjf%fnow,3) ',sdjf%ln_tint,SIZE(sdjf%fnow,3) ; call flush(narea+200) 448 write(narea+200,*)' SIZE(sdjf%fdta,3) SIZE(sdjf%fdta,4) ',SIZE(sdjf%fdta,3),SIZE(sdjf%fdta,4) ; call flush(narea+200) 449 SELECT CASE( SIZE(sdjf%fnow,3) ) 411 450 CASE(1) 412 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_b(1) ) 451 IF( sdjf%ln_tint ) THEN 452 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_b(1) ) 453 ELSE 454 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,1) , sdjf%nrec_b(1) ) 455 ENDIF 413 456 CASE(jpk) 414 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_b(1) ) 457 IF( sdjf%ln_tint ) THEN 458 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_b(1) ) 459 ELSE 460 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,:) , sdjf%nrec_b(1) ) 461 ENDIF 415 462 END SELECT 463 write(narea+200,*)' test1 ok ' ; call flush(narea+200) 416 464 ENDIF 417 465 sdjf%rotn(2) = .FALSE. … … 629 677 & ' pairing : ' , TRIM( sdf(jf)%vcomp ), & 630 678 & ' data type: ' , sdf(jf)%cltype 679 call flush(numout) 631 680 END DO 632 681 ENDIF … … 891 940 ! SA: +3 stencil is a patch to avoid out-of-bound computation in some configuration. 892 941 ! a more robust solution will be given in next release 893 ipk = SIZE(sd%f dta,3)942 ipk = SIZE(sd%fnow,3) 894 943 ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3 ,ipk) ) 895 944 IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col2(2,ref_wgts(nxt_wgt)%jpjwgt+3,ipk) ) … … 912 961 !! ** Method : 913 962 !!---------------------------------------------------------------------- 914 INTEGER, INTENT(in) 915 CHARACTER(LEN=*), INTENT(in) 916 INTEGER, INTENT(in) 917 INTEGER, INTENT(in) 918 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kk) :: dta 919 INTEGER, INTENT(in) 963 INTEGER, INTENT(in) :: num ! stream number 964 CHARACTER(LEN=*), INTENT(in) :: clvar ! variable name 965 INTEGER, INTENT(in) :: kw ! weights number 966 INTEGER, INTENT(in) :: kk ! vertical dimension of kk 967 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kk) :: dta ! output field on model grid 968 INTEGER, INTENT(in) :: nrec ! record number to read (ie time slice) 920 969 !! 921 INTEGER, DIMENSION(3) 922 INTEGER 923 INTEGER 924 INTEGER 925 INTEGER 926 INTEGER 970 INTEGER, DIMENSION(3) :: rec1,recn ! temporary arrays for start and length 971 INTEGER :: jk, jn, jm ! loop counters 972 INTEGER :: ni, nj ! lengths 973 INTEGER :: jpimin,jpiwid ! temporary indices 974 INTEGER :: jpjmin,jpjwid ! temporary indices 975 INTEGER :: jpi1,jpi2,jpj1,jpj2 ! temporary indices 927 976 !!---------------------------------------------------------------------- 928 977 !
Note: See TracChangeset
for help on using the changeset viewer.
