- Timestamp:
- 2020-05-22T09:05:34+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/SBC/fldread.F90
r12866 r12960 53 53 LOGICAL :: ln_tint ! time interpolation or not (T/F) 54 54 LOGICAL :: ln_clim ! climatology or not (T/F) 55 CHARACTER(len = 8) :: cl type! type of data file 'daily', 'monthly' or yearly'55 CHARACTER(len = 8) :: clftyp ! type of data file 'daily', 'monthly' or yearly' 56 56 CHARACTER(len = 256) :: wname ! generic name of a NetCDF weights file to be used, blank if not 57 57 CHARACTER(len = 34) :: vcomp ! symbolic component name if a vector that needs rotation … … 69 69 LOGICAL :: ln_tint ! time interpolation or not (T/F) 70 70 LOGICAL :: ln_clim ! climatology or not (T/F) 71 CHARACTER(len = 8) :: cltype ! type of data file 'daily', 'monthly' or yearly' 71 CHARACTER(len = 8) :: clftyp ! type of data file 'daily', 'monthly' or yearly' 72 CHARACTER(len = 1) :: cltype ! nature of grid-points: T, U, V... 73 REAL(wp) :: zsgn ! -1. the sign change across the north fold, = 1. otherwise 72 74 INTEGER :: num ! iom id of the jpfld files to be read 73 75 INTEGER , DIMENSION(2,2) :: nrec ! before/after record (1: index, 2: second since Jan. 1st 00h of yr nit000) 74 76 INTEGER :: nbb ! index of before values 75 77 INTEGER :: naa ! index of after values 76 INTEGER , ALLOCATABLE, DIMENSION(: 77 REAL(wp), ALLOCATABLE, DIMENSION(:,:,: ) :: fnow ! input fields interpolated to now time step78 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: fdta ! 2 consecutive record of input fields78 INTEGER , ALLOCATABLE, DIMENSION(:) :: nrecsec ! 79 REAL(wp), POINTER, DIMENSION(:,:,: ) :: fnow ! input fields interpolated to now time step 80 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: fdta ! 2 consecutive record of input fields 79 81 CHARACTER(len = 256) :: wgtname ! current name of the NetCDF weight file acting as a key 80 82 ! ! into the WGTLIST structure … … 351 353 INTEGER :: iaa ! shorter name for sdjf%naa 352 354 INTEGER :: iw ! index into wgts array 353 INTEGER :: ipdom ! index of the domain354 355 INTEGER :: idvar ! variable ID 355 356 INTEGER :: idmspc ! number of spatial dimensions 356 357 LOGICAL :: lmoor ! C1D case: point data 357 !!--------------------------------------------------------------------- 358 ! 359 ipk = SIZE( sdjf%fnow, 3 ) 358 REAL(wp), DIMENSION(:,:,:), POINTER :: dta_alias ! short cut 359 !!--------------------------------------------------------------------- 360 360 iaa = sdjf%naa 361 361 ! 362 IF( ASSOCIATED(sdjf%imap) ) THEN 363 IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,iaa), sdjf%nrec(1,iaa), & 364 & sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint, Kmm ) 365 ELSE ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec(1,iaa), & 366 & sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint, Kmm ) 367 ENDIF 368 ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 362 IF( sdjf%ln_tint ) THEN ; dta_alias => sdjf%fdta(:,:,:,iaa) 363 ELSE ; dta_alias => sdjf%fnow(:,:,: ) 364 ENDIF 365 ipk = SIZE( dta_alias, 3 ) 366 ! 367 IF( ASSOCIATED(sdjf%imap) ) THEN ! BDY case 368 CALL fld_map( sdjf%num, sdjf%clvar, dta_alias(:,:,:), sdjf%nrec(1,iaa), & 369 & sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint, Kmm ) 370 ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN ! On-the-fly interpolation 369 371 CALL wgt_list( sdjf, iw ) 370 IF( sdjf%ln_tint ) THEN ; CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, sdjf%fdta(:,:,:,iaa), & 371 & sdjf%nrec(1,iaa), sdjf%lsmname ) 372 CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,:,iaa), 'T', 1._wp, kfillmode = jpfillcopy ) 373 ELSE ; CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, sdjf%fnow(:,:,: ), & 374 & sdjf%nrec(1,iaa), sdjf%lsmname ) 375 CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,: ), 'T', 1._wp, kfillmode = jpfillcopy ) 376 ENDIF 377 ELSE 378 IF( SIZE(sdjf%fnow, 1) == jpi ) THEN ; ipdom = jpdom_global 379 ELSE ; ipdom = jpdom_unknown 380 ENDIF 372 CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, dta_alias(:,:,:), sdjf%nrec(1,iaa), sdjf%lsmname ) 373 CALL lbc_lnk( 'fldread', dta_alias(:,:,:), sdjf%cltype, sdjf%zsgn, kfillmode = jpfillcopy ) 374 ELSE ! default case 381 375 ! C1D case: If product of spatial dimensions == ipk, then x,y are of 382 376 ! size 1 (point/mooring data): this must be read onto the central grid point 383 377 idvar = iom_varid( sdjf%num, sdjf%clvar ) 384 378 idmspc = iom_file ( sdjf%num )%ndims( idvar ) 385 IF( iom_file( sdjf%num )%luld( idvar ) ) idmspc = idmspc - 1 386 lmoor = ( idmspc == 0 .OR. PRODUCT( iom_file( sdjf%num )%dimsz( 1:MAX(idmspc,1) ,idvar ) ) == ipk ) 387 ! 388 SELECT CASE( ipk ) 389 CASE(1) 390 IF( lk_c1d .AND. lmoor ) THEN 391 IF( sdjf%ln_tint ) THEN 392 CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fdta(2,2,1,iaa), sdjf%nrec(1,iaa) ) 393 CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,1,iaa),'T',1., kfillmode = jpfillcopy ) 394 ELSE 395 CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fnow(2,2,1 ), sdjf%nrec(1,iaa) ) 396 CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,1 ),'T',1., kfillmode = jpfillcopy ) 397 ENDIF 398 ELSE 399 IF( sdjf%ln_tint ) THEN 400 CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,1,iaa), sdjf%nrec(1,iaa), kfill = jpfillcopy ) 401 ELSE 402 CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,1 ), sdjf%nrec(1,iaa), kfill = jpfillcopy ) 403 ENDIF 404 ENDIF 405 CASE DEFAULT 406 IF(lk_c1d .AND. lmoor ) THEN 407 IF( sdjf%ln_tint ) THEN 408 CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fdta(2,2,:,iaa), sdjf%nrec(1,iaa) ) 409 CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,:,iaa),'T',1., kfillmode = jpfillcopy ) 410 ELSE 411 CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fnow(2,2,: ), sdjf%nrec(1,iaa) ) 412 CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,: ),'T',1., kfillmode = jpfillcopy ) 413 ENDIF 414 ELSE 415 IF( sdjf%ln_tint ) THEN 416 CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,:,iaa), sdjf%nrec(1,iaa), kfill = jpfillcopy ) 417 ELSE 418 CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec(1,iaa), kfill = jpfillcopy ) 419 ENDIF 420 ENDIF 421 END SELECT 379 IF( iom_file( sdjf%num )%luld( idvar ) ) idmspc = idmspc - 1 ! id of the last spatial dimension 380 lmoor = ( idmspc == 0 .OR. PRODUCT( iom_file( sdjf%num )%dimsz( 1:MAX(idmspc,1) ,idvar ) ) == ipk ) 381 ! 382 IF( lk_c1d .AND. lmoor ) THEN 383 CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, dta_alias(2,2,:), sdjf%nrec(1,iaa) ) ! jpdom_unknown -> no lbc_lnk 384 CALL lbc_lnk( 'fldread', dta_alias(:,:,:), 'T', 1., kfillmode = jpfillcopy ) 385 ELSE 386 CALL iom_get( sdjf%num, jpdom_global, sdjf%clvar, dta_alias(:,:,:), sdjf%nrec(1,iaa), & 387 & sdjf%cltype, sdjf%zsgn, kfill = jpfillcopy ) 388 ENDIF 422 389 ENDIF 423 390 ! … … 458 425 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zdta_read_z ! work space local data requiring vertical interpolation 459 426 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zdta_read_dz ! work space local data requiring vertical interpolation 460 CHARACTER(LEN=1),DIMENSION(3) :: cl grid427 CHARACTER(LEN=1),DIMENSION(3) :: cltype 461 428 LOGICAL :: lluld ! is the variable using the unlimited dimension 462 429 LOGICAL :: llzint ! local value of ldzint 463 430 !!--------------------------------------------------------------------- 464 431 ! 465 cl grid= (/'t','u','v'/)432 cltype = (/'t','u','v'/) 466 433 ! 467 434 ipi = SIZE( pdta, 1 ) … … 498 465 IF( ipkb /= ipk .OR. llzint ) THEN ! boundary data not on model vertical grid : vertical interpolation 499 466 ! 500 IF( ipk == jpk .AND. iom_varid(knum,'gdep'//cl grid(kgrd)) /= -1 .AND. iom_varid(knum,'e3'//clgrid(kgrd)) /= -1 ) THEN467 IF( ipk == jpk .AND. iom_varid(knum,'gdep'//cltype(kgrd)) /= -1 .AND. iom_varid(knum,'e3'//cltype(kgrd)) /= -1 ) THEN 501 468 502 469 ALLOCATE( zdta_read(ipi,ipj,ipkb), zdta_read_z(ipi,ipj,ipkb), zdta_read_dz(ipi,ipj,ipkb) ) 503 470 504 471 CALL fld_map_core( zz_read, kmap, zdta_read ) 505 CALL iom_get ( knum, jpdom_unknown, 'gdep'//cl grid(kgrd), zz_read ) ! read only once? Potential temporal evolution?472 CALL iom_get ( knum, jpdom_unknown, 'gdep'//cltype(kgrd), zz_read ) ! read only once? Potential temporal evolution? 506 473 CALL fld_map_core( zz_read, kmap, zdta_read_z ) 507 CALL iom_get ( knum, jpdom_unknown, 'e3'//cl grid(kgrd), zz_read ) ! read only once? Potential temporal evolution?474 CALL iom_get ( knum, jpdom_unknown, 'e3'//cltype(kgrd), zz_read ) ! read only once? Potential temporal evolution? 508 475 CALL fld_map_core( zz_read, kmap, zdta_read_dz ) 509 476 … … 515 482 IF( ipk /= jpk ) CALL ctl_stop( 'fld_map : this should be an impossible case...' ) 516 483 WRITE(ctmp1,*) 'fld_map : vertical interpolation for bdy variable '//TRIM(cdvar)//' requires ' 517 IF( iom_varid(knum, 'gdep'//cl grid(kgrd)) == -1 ) CALL ctl_stop( ctmp1//'gdep'//clgrid(kgrd)//' variable' )518 IF( iom_varid(knum, 'e3'//cl grid(kgrd)) == -1 ) CALL ctl_stop( ctmp1// 'e3'//clgrid(kgrd)//' variable' )484 IF( iom_varid(knum, 'gdep'//cltype(kgrd)) == -1 ) CALL ctl_stop( ctmp1//'gdep'//cltype(kgrd)//' variable' ) 485 IF( iom_varid(knum, 'e3'//cltype(kgrd)) == -1 ) CALL ctl_stop( ctmp1// 'e3'//cltype(kgrd)//' variable' ) 519 486 520 487 ENDIF … … 739 706 CHARACTER (LEN=100) :: clcomp ! dummy weight name 740 707 REAL(wp), DIMENSION(jpi,jpj) :: utmp, vtmp ! temporary arrays for vector rotation 708 REAL(wp), DIMENSION(:,:,:), POINTER :: dta_u, dta_v ! short cut 741 709 !!--------------------------------------------------------------------- 742 710 ! … … 758 726 END DO 759 727 IF( iv > 0 ) THEN ! fields ju and iv are two components which need to be rotated together 728 IF( sd(ju)%ln_tint ) THEN ; dta_u => sd(ju)%fdta(:,:,:,jn) ; dta_v => sd(iv)%fdta(:,:,:,jn) 729 ELSE ; dta_u => sd(ju)%fnow(:,:,: ) ; dta_v => sd(iv)%fnow(:,:,: ) 730 ENDIF 760 731 DO jk = 1, SIZE( sd(ju)%fnow, 3 ) 761 IF( sd(ju)%ln_tint )THEN 762 CALL rot_rep( sd(ju)%fdta(:,:,jk,jn), sd(iv)%fdta(:,:,jk,jn), 'T', 'en->i', utmp(:,:) ) 763 CALL rot_rep( sd(ju)%fdta(:,:,jk,jn), sd(iv)%fdta(:,:,jk,jn), 'T', 'en->j', vtmp(:,:) ) 764 sd(ju)%fdta(:,:,jk,jn) = utmp(:,:) ; sd(iv)%fdta(:,:,jk,jn) = vtmp(:,:) 765 ELSE 766 CALL rot_rep( sd(ju)%fnow(:,:,jk ), sd(iv)%fnow(:,:,jk ), 'T', 'en->i', utmp(:,:) ) 767 CALL rot_rep( sd(ju)%fnow(:,:,jk ), sd(iv)%fnow(:,:,jk ), 'T', 'en->j', vtmp(:,:) ) 768 sd(ju)%fnow(:,:,jk ) = utmp(:,:) ; sd(iv)%fnow(:,:,jk ) = vtmp(:,:) 769 ENDIF 732 CALL rot_rep( dta_u(:,:,jk), dta_v(:,:,jk), 'T', 'en->i', utmp(:,:) ) 733 CALL rot_rep( dta_u(:,:,jk), dta_v(:,:,jk), 'T', 'en->j', vtmp(:,:) ) 734 dta_u(:,:,jk) = utmp(:,:) ; dta_v(:,:,jk) = vtmp(:,:) 770 735 END DO 771 736 sd(ju)%rotn(jn) = .TRUE. ! vector was rotated … … 813 778 814 779 ! current file parameters 815 IF( sdjf%cl type(1:4) == 'week' ) THEN! find the day of the beginning of the current week816 isecwk = ksec_week( sdjf%cl type(6:8) ) ! seconds between the beginning of the week and half of current time step817 llprevmt = isecwk > nsec_month 780 IF( sdjf%clftyp(1:4) == 'week' ) THEN ! find the day of the beginning of the current week 781 isecwk = ksec_week( sdjf%clftyp(6:8) ) ! seconds between the beginning of the week and half of current time step 782 llprevmt = isecwk > nsec_month ! longer time since beginning of the current week than the current month 818 783 llprevyr = llprevmt .AND. nmonth == 1 819 784 iyr = nyear - COUNT((/llprevyr/)) 820 785 imt = nmonth - COUNT((/llprevmt/)) + 12 * COUNT((/llprevyr/)) 821 786 idy = nday + nmonth_len(nmonth-1) * COUNT((/llprevmt/)) - isecwk / idaysec 822 isecwk = nsec_year - isecwk ! seconds between 00h jan 1st of current year and current week beginning787 isecwk = nsec_year - isecwk ! seconds between 00h jan 1st of current year and current week beginning 823 788 ELSE 824 789 iyr = nyear … … 830 795 ! previous file parameters 831 796 IF( llprev ) THEN 832 IF( sdjf%cl type(1:4) == 'week' ) THEN! find the day of the beginning of previous week833 isecwk = isecwk + 7 * idaysec ! seconds between the beginning of previous week and half of the time step834 llprevmt = isecwk > nsec_month 797 IF( sdjf%clftyp(1:4) == 'week' ) THEN ! find the day of the beginning of previous week 798 isecwk = isecwk + 7 * idaysec ! seconds between the beginning of previous week and half of the time step 799 llprevmt = isecwk > nsec_month ! longer time since beginning of the previous week than the current month 835 800 llprevyr = llprevmt .AND. nmonth == 1 836 801 iyr = nyear - COUNT((/llprevyr/)) 837 802 imt = nmonth - COUNT((/llprevmt/)) + 12 * COUNT((/llprevyr/)) 838 803 idy = nday + nmonth_len(nmonth-1) * COUNT((/llprevmt/)) - isecwk / idaysec 839 isecwk = nsec_year - isecwk ! seconds between 00h jan 1st of current year and previous week beginning804 isecwk = nsec_year - isecwk ! seconds between 00h jan 1st of current year and previous week beginning 840 805 ELSE 841 idy = nday - COUNT((/ sdjf%cl type== 'daily' /))842 imt = nmonth - COUNT((/ sdjf%cl type== 'monthly' .OR. idy == 0 /))843 iyr = nyear - COUNT((/ sdjf%cl type== 'yearly' .OR. imt == 0 /))806 idy = nday - COUNT((/ sdjf%clftyp == 'daily' /)) 807 imt = nmonth - COUNT((/ sdjf%clftyp == 'monthly' .OR. idy == 0 /)) 808 iyr = nyear - COUNT((/ sdjf%clftyp == 'yearly' .OR. imt == 0 /)) 844 809 IF( idy == 0 ) idy = nmonth_len(imt) 845 810 IF( imt == 0 ) imt = 12 … … 850 815 ! next file parameters 851 816 IF( llnext ) THEN 852 IF( sdjf%cl type(1:4) == 'week' ) THEN! find the day of the beginning of next week853 isecwk = 7 * idaysec - isecwk ! seconds between half of the time step and the beginning of next week817 IF( sdjf%clftyp(1:4) == 'week' ) THEN ! find the day of the beginning of next week 818 isecwk = 7 * idaysec - isecwk ! seconds between half of the time step and the beginning of next week 854 819 llnextmt = isecwk > ( nmonth_len(nmonth)*idaysec - nsec_month ) ! larger than the seconds to the end of the month 855 820 llnextyr = llnextmt .AND. nmonth == 12 … … 857 822 imt = nmonth + COUNT((/llnextmt/)) - 12 * COUNT((/llnextyr/)) 858 823 idy = nday - nmonth_len(nmonth) * COUNT((/llnextmt/)) + isecwk / idaysec + 1 859 isecwk = nsec_year + isecwk ! seconds between 00h jan 1st of current year and next week beginning824 isecwk = nsec_year + isecwk ! seconds between 00h jan 1st of current year and next week beginning 860 825 ELSE 861 idy = nday + COUNT((/ sdjf%cl type== 'daily' /))862 imt = nmonth + COUNT((/ sdjf%cl type== 'monthly' .OR. idy > nmonth_len(nmonth) /))863 iyr = nyear + COUNT((/ sdjf%cl type== 'yearly' .OR. imt == 13 /))826 idy = nday + COUNT((/ sdjf%clftyp == 'daily' /)) 827 imt = nmonth + COUNT((/ sdjf%clftyp == 'monthly' .OR. idy > nmonth_len(nmonth) /)) 828 iyr = nyear + COUNT((/ sdjf%clftyp == 'yearly' .OR. imt == 13 /)) 864 829 IF( idy > nmonth_len(nmonth) ) idy = 1 865 830 IF( imt == 13 ) imt = 1 … … 878 843 IF ( NINT(sdjf%freqh) == -12 ) THEN ; ireclast = 1 ! yearly mean: consider only 1 record 879 844 ELSEIF( NINT(sdjf%freqh) == -1 ) THEN ! monthly mean: 880 IF( sdjf%cl type== 'monthly' ) THEN ; ireclast = 1 ! consider that the file has 1 record845 IF( sdjf%clftyp == 'monthly' ) THEN ; ireclast = 1 ! consider that the file has 1 record 881 846 ELSE ; ireclast = 12 ! consider that the file has 12 record 882 847 ENDIF 883 848 ELSE ! higher frequency mean (in hours) 884 IF( sdjf%cl type== 'monthly' ) THEN ; ireclast = NINT( 24. * REAL(nmonth_len(indexmt), wp) / sdjf%freqh )885 ELSEIF( sdjf%cl type(1:4) == 'week' ) THEN ; ireclast = NINT( 24. * 7. / sdjf%freqh )886 ELSEIF( sdjf%cl type== 'daily' ) THEN ; ireclast = NINT( 24. / sdjf%freqh )849 IF( sdjf%clftyp == 'monthly' ) THEN ; ireclast = NINT( 24. * REAL(nmonth_len(indexmt), wp) / sdjf%freqh ) 850 ELSEIF( sdjf%clftyp(1:4) == 'week' ) THEN ; ireclast = NINT( 24. * 7. / sdjf%freqh ) 851 ELSEIF( sdjf%clftyp == 'daily' ) THEN ; ireclast = NINT( 24. / sdjf%freqh ) 887 852 ELSE ; ireclast = NINT( 24. * REAL( nyear_len(indexyr), wp) / sdjf%freqh ) 888 853 ENDIF … … 902 867 sdjf%nrecsec(1) = sdjf%nrecsec(0) + nyear_len( indexyr ) * idaysec 903 868 ELSEIF( NINT(sdjf%freqh) == -1 ) THEN ! monthly mean: 904 IF( sdjf%cl type== 'monthly' ) THEN ! monthly file869 IF( sdjf%clftyp == 'monthly' ) THEN ! monthly file 905 870 sdjf%nrecsec(0 ) = nsec1jan000 + nmonth_beg(indexmt ) 906 871 sdjf%nrecsec(1 ) = nsec1jan000 + nmonth_beg(indexmt+1) … … 910 875 ENDIF 911 876 ELSE ! higher frequency mean (in hours) 912 IF( sdjf%cl type== 'monthly' ) THEN ; istart = nsec1jan000 + nmonth_beg(indexmt)913 ELSEIF( sdjf%cl type(1:4) == 'week' ) THEN ; istart = nsec1jan000 + isecwk914 ELSEIF( sdjf%cl type== 'daily' ) THEN ; istart = nsec1jan000 + nmonth_beg(indexmt) + ( idy - 1 ) * idaysec877 IF( sdjf%clftyp == 'monthly' ) THEN ; istart = nsec1jan000 + nmonth_beg(indexmt) 878 ELSEIF( sdjf%clftyp(1:4) == 'week' ) THEN ; istart = nsec1jan000 + isecwk 879 ELSEIF( sdjf%clftyp == 'daily' ) THEN ; istart = nsec1jan000 + nmonth_beg(indexmt) + ( idy - 1 ) * idaysec 915 880 ELSEIF( indexyr == 0 ) THEN ; istart = nsec1jan000 - nyear_len( 0 ) * idaysec 916 881 ELSEIF( indexyr == 2 ) THEN ; istart = nsec1jan000 + nyear_len( 1 ) * idaysec … … 1008 973 sdf(jf)%ln_tint = sdf_n(jf)%ln_tint 1009 974 sdf(jf)%ln_clim = sdf_n(jf)%ln_clim 1010 sdf(jf)%cltype = sdf_n(jf)%cltype 975 sdf(jf)%clftyp = sdf_n(jf)%clftyp 976 sdf(jf)%cltype = 'T' ! by default don't do any call to lbc_lnk in iom_get 977 sdf(jf)%zsgn = 1. ! by default don't do change signe across the north fold 1011 978 sdf(jf)%num = -1 1012 979 sdf(jf)%nbb = 1 ! start with before data in 1 … … 1018 985 sdf(jf)%vcomp = sdf_n(jf)%vcomp 1019 986 sdf(jf)%rotn(:) = .TRUE. ! pretend to be rotated -> won't try to rotate data before the first call to fld_get 1020 IF( sdf(jf)%cl type(1:4) == 'week' .AND. nn_leapy == 0 ) &987 IF( sdf(jf)%clftyp(1:4) == 'week' .AND. nn_leapy == 0 ) & 1021 988 & CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdf(jf)%clrootname)//') needs nn_leapy = 1') 1022 IF( sdf(jf)%cl type(1:4) == 'week' .AND. sdf(jf)%ln_clim ) &989 IF( sdf(jf)%clftyp(1:4) == 'week' .AND. sdf(jf)%ln_clim ) & 1023 990 & CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdf(jf)%clrootname)//') needs ln_clim = .FALSE.') 1024 991 sdf(jf)%nreclast = -1 ! Set to non zero default value to avoid errors, is updated to meaningful value during fld_clopn … … 1046 1013 WRITE(numout,*) ' weights: ' , TRIM( sdf(jf)%wgtname ), & 1047 1014 & ' pairing: ' , TRIM( sdf(jf)%vcomp ), & 1048 & ' data type: ' , sdf(jf)%cl type, &1015 & ' data type: ' , sdf(jf)%clftyp , & 1049 1016 & ' land/sea mask:' , TRIM( sdf(jf)%lsmname ) 1050 1017 call flush(numout) … … 1202 1169 CALL iom_get ( inum, jpdom_global, clname, data_tmp(:,:), cd_type = 'Z' ) ! no call to lbc_lnk 1203 1170 DO_2D_00_00 1204 !!$ isrc = NINT(data_tmp(ji,jj)) - 1 1205 isrc = INT(data_tmp(ji,jj)) - 1 1171 isrc = NINT(data_tmp(ji,jj)) - 1 1206 1172 ref_wgts(nxt_wgt)%data_jpi(ji,jj,jn) = 1 + MOD(isrc, ref_wgts(nxt_wgt)%ddims(1)) 1207 1173 ref_wgts(nxt_wgt)%data_jpj(ji,jj,jn) = 1 + isrc / ref_wgts(nxt_wgt)%ddims(1) … … 1589 1555 IF( .NOT. sdjf%ln_clim ) THEN 1590 1556 WRITE(clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear ! add year 1591 IF( sdjf%cl type/= 'yearly' ) WRITE(clname, '(a, "m",i2.2)' ) TRIM( clname ), kmonth ! add month1557 IF( sdjf%clftyp /= 'yearly' ) WRITE(clname, '(a, "m",i2.2)' ) TRIM( clname ), kmonth ! add month 1592 1558 ELSE 1593 1559 ! build the new filename if climatological data 1594 IF( sdjf%cl type/= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth ! add month1595 ENDIF 1596 IF( sdjf%cl type == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) &1560 IF( sdjf%clftyp /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth ! add month 1561 ENDIF 1562 IF( sdjf%clftyp == 'daily' .OR. sdjf%clftyp(1:4) == 'week' ) & 1597 1563 & WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname ), kday ! add day 1598 1564 … … 1618 1584 IF( cl_week(ijul) == TRIM(cdday) ) EXIT 1619 1585 END DO 1620 IF( ijul .GT. 7 ) CALL ctl_stop( 'ksec_week: wrong day for sdjf%cl type(6:8): '//TRIM(cdday) )1586 IF( ijul .GT. 7 ) CALL ctl_stop( 'ksec_week: wrong day for sdjf%clftyp(6:8): '//TRIM(cdday) ) 1621 1587 ! 1622 1588 ishift = ijul * NINT(rday)
Note: See TracChangeset
for help on using the changeset viewer.
