- Timestamp:
- 2010-09-27T12:22:04+02:00 (14 years ago)
- Location:
- branches/DEV_r1784_3DF/NEMO/OPA_SRC
- Files:
-
- 11 edited
-
DIA/diawri.F90 (modified) (2 diffs)
-
DTA/dtasal.F90 (modified) (1 diff)
-
DTA/dtatem.F90 (modified) (1 diff)
-
SBC/fldread.F90 (modified) (11 diffs)
-
SBC/sbcblk_clio.F90 (modified) (2 diffs)
-
SBC/sbcblk_core.F90 (modified) (1 diff)
-
SBC/sbcflx.F90 (modified) (1 diff)
-
SBC/sbcice_if.F90 (modified) (1 diff)
-
SBC/sbcrnf.F90 (modified) (1 diff)
-
SBC/sbcssr.F90 (modified) (2 diffs)
-
TRA/traqsr.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r1784_3DF/NEMO/OPA_SRC/DIA/diawri.F90
r1756 r2125 30 30 USE limwri_2 31 31 #endif 32 USE dtatem 33 USE dtasal 34 32 35 IMPLICIT NONE 33 36 PRIVATE … … 489 492 490 493 ! Write fields on T grid 491 CALL histwrite( nid_T, "votemper", it, t n, ndim_T , ndex_T ) ! temperature492 CALL histwrite( nid_T, "vosaline", it, s n, ndim_T , ndex_T ) ! salinity494 CALL histwrite( nid_T, "votemper", it, t_dta , ndim_T , ndex_T ) ! temperature 495 CALL histwrite( nid_T, "vosaline", it, s_dta , ndim_T , ndex_T ) ! salinity 493 496 CALL histwrite( nid_T, "sosstsst", it, tn(:,:,1) , ndim_hT, ndex_hT ) ! sea surface temperature 494 497 CALL histwrite( nid_T, "sosaline", it, sn(:,:,1) , ndim_hT, ndex_hT ) ! sea surface salinity -
branches/DEV_r1784_3DF/NEMO/OPA_SRC/DTA/dtasal.F90
r2051 r2125 114 114 CALL ctl_stop( 'dta_sal: unable to allocate sf_sal structure' ) ; RETURN 115 115 ENDIF 116 ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk) ) 117 ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2) ) 118 116 117 #if defined key_orca_lev10 118 ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpkdta) ) 119 IF( sn_sal%ln_tint ) ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpkdta,2) ) 120 #else 121 ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk) ) 122 IF( sn_sal%ln_tint ) ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2) ) 123 #endif 119 124 ! fill sf_sal with sn_sal and control print 120 125 CALL fld_fill( sf_sal, (/ sn_sal /), cn_dir, 'dta_sal', 'Salinity data', 'namdta_sal' ) -
branches/DEV_r1784_3DF/NEMO/OPA_SRC/DTA/dtatem.F90
r2051 r2125 122 122 #if defined key_orca_lev10 123 123 ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpkdta) ) 124 ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpkdta,2) )124 IF( sn_tem%ln_tint ) ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpkdta,2) ) 125 125 #else 126 126 ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk) ) 127 ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) )127 IF( sn_tem%ln_tint ) ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) ) 128 128 #endif 129 129 ! fill sf_tem with sn_tem and control print -
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 ! -
branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r2051 r2125 129 129 & sn_ccov, sn_tair, sn_prec 130 130 !!--------------------------------------------------------------------- 131 write(narea+200,*)'clio : '; call flush(narea+200) 131 132 132 133 ! ! ====================== ! … … 160 161 CALL ctl_stop( 'sbc_blk_clio: unable to allocate sf structure' ) ; RETURN 161 162 ENDIF 162 163 163 DO ifpr= 1, jpfld 164 164 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 165 ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 166 END DO 167 168 165 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 166 END DO 169 167 ! fill sf with slf_i and control print 170 168 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_clio', 'flux formulation for ocean surface boundary condition', 'namsbc_clio' ) -
branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r2051 r2125 165 165 DO ifpr= 1, jfld 166 166 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 167 ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) )167 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 168 168 END DO 169 169 ! -
branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC/sbcflx.F90
r2051 r2125 127 127 DO ji= 1, jpfld 128 128 ALLOCATE( sf(ji)%fnow(jpi,jpj,1) ) 129 ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) )129 IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) ) 130 130 END DO 131 131 -
branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC/sbcice_if.F90
r2051 r2125 82 82 ENDIF 83 83 ALLOCATE( sf_ice(1)%fnow(jpi,jpj,1) ) 84 ALLOCATE( sf_ice(1)%fdta(jpi,jpj,1,2) )84 IF( sn_ice%ln_tint ) ALLOCATE( sf_ice(1)%fdta(jpi,jpj,1,2) ) 85 85 86 86 -
branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC/sbcrnf.F90
r2051 r2125 75 75 CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' ) ; RETURN 76 76 ENDIF 77 ENDIF 78 CALL sbc_rnf_init(sf_rnf) 79 IF( .NOT. ln_rnf_emp ) THEN 77 80 ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1) ) 78 ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 79 ENDIF 80 CALL sbc_rnf_init(sf_rnf) 81 IF( sf_rnf(1)%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 82 ENDIF 81 83 ENDIF 82 84 -
branches/DEV_r1784_3DF/NEMO/OPA_SRC/SBC/sbcssr.F90
r2051 r2125 116 116 ENDIF 117 117 ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1) ) 118 ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2) )119 118 ! 120 119 ! fill sf_sst with sn_sst and control print 121 120 CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' ) 121 IF( sf_sst(1)%ln_tint ) ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2) ) 122 122 ENDIF 123 123 ! … … 129 129 ENDIF 130 130 ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1) ) 131 ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2) )132 131 ! 133 132 ! fill sf_sss with sn_sss and control print 134 133 CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' ) 134 IF( sf_sss(1)%ln_tint )ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2) ) 135 135 ENDIF 136 136 ! -
branches/DEV_r1784_3DF/NEMO/OPA_SRC/TRA/traqsr.F90
r1806 r2125 335 335 ENDIF 336 336 ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1) ) 337 ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) )337 IF( sn_chl%ln_tint )ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) ) 338 338 ! ! fill sf_chl with sn_chl and control print 339 339 CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init', &
Note: See TracChangeset
for help on using the changeset viewer.
