- Timestamp:
- 2016-11-21T11:40:00+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r6140 r7280 4 4 !! Ocean forcing: read input field for surface boundary condition 5 5 !!===================================================================== 6 !! History : 2.0 ! 06-2006 (S. Masson, G. Madec) Original code7 !! ! 05-2008(S. Alderson) Modified for Interpolation in memory from input grid to model grid8 !! ! 10-2013(D. Delrosso, P. Oddo) suppression of land point prior to interpolation6 !! History : 2.0 ! 2006-06 (S. Masson, G. Madec) Original code 7 !! 3.0 ! 2008-05 (S. Alderson) Modified for Interpolation in memory from input grid to model grid 8 !! 3.4 ! 2013-10 (D. Delrosso, P. Oddo) suppression of land point prior to interpolation 9 9 !!---------------------------------------------------------------------- 10 10 11 11 !!---------------------------------------------------------------------- 12 !! fld_read : read input fields used for the computation of the 13 !! surface boundary condition 12 !! fld_read : read input fields used for the computation of the surface boundary condition 13 !! fld_init : initialization of field read 14 !! fld_rec : determined the record(s) to be read 15 !! fld_get : read the data 16 !! fld_map : read global data from file and map onto local data using a general mapping (use for open boundaries) 17 !! fld_rot : rotate the vector fields onto the local grid direction 18 !! fld_clopn : update the data file name and close/open the files 19 !! fld_fill : fill the data structure with the associated information read in namelist 20 !! wgt_list : manage the weights used for interpolation 21 !! wgt_print : print the list of known weights 22 !! fld_weight : create a WGT structure and fill in data from file, restructuring as required 23 !! apply_seaoverland : fill land with ocean values 24 !! seaoverland : create shifted matrices for seaoverland application 25 !! fld_interp : apply weights to input gridded data to create data on model grid 26 !! ksec_week : function returning the first 3 letters of the first day of the weekly file 14 27 !!---------------------------------------------------------------------- 15 28 USE oce ! ocean dynamics and tracers … … 274 287 IF( sd(jf)%ln_tint ) THEN ! temporal interpolation 275 288 IF(lwp .AND. kt - nit000 <= 100 ) THEN 276 clfmt = "(' fld_read: var ', a, ' kt = ', i8, ' (', f9.4,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," // &289 clfmt = "(' fld_read: var ', a, ' kt = ', i8, ' (', f9.4,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," // & 277 290 & "', records b/a: ', i6.4, '/', i6.4, ' (days ', f9.4,'/', f9.4, ')')" 278 291 WRITE(numout, clfmt) TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday, & 279 292 & sd(jf)%nrec_b(1), sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday 280 WRITE(numout, *) ' it_offset is : ',it_offset293 WRITE(numout, *) ' it_offset is : ',it_offset 281 294 ENDIF 282 295 ! temporal interpolation weights … … 286 299 ELSE ! nothing to do... 287 300 IF(lwp .AND. kt - nit000 <= 100 ) THEN 288 clfmt = "(' fld_read: var ', a, ' kt = ', i8,' (', f9.4,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," // &301 clfmt = "(' fld_read: var ', a, ' kt = ', i8,' (', f9.4,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," // & 289 302 & "', record: ', i6.4, ' (days ', f9.4, ' <-> ', f9.4, ')')" 290 303 WRITE(numout, clfmt) TRIM(sd(jf)%clvar), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday, & … … 407 420 CALL fld_get( sdjf, map ) ! read before data in after arrays(as we will swap it later) 408 421 ! 409 clfmt = "(' fld_init : time-interpolation for ', a, ' read previous record = ', i6, ' at time = ', f7.2, ' days')"422 clfmt = "(' fld_init : time-interpolation for ', a, ' read previous record = ', i6, ' at time = ', f7.2, ' days')" 410 423 IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday 411 424 ! … … 791 804 !! *** ROUTINE fld_clopn *** 792 805 !! 793 !! ** Purpose : update the file name and open the file806 !! ** Purpose : update the file name and close/open the files 794 807 !!---------------------------------------------------------------------- 795 808 TYPE(FLD) , INTENT(inout) :: sdjf ! input field related variables … … 882 895 883 896 884 SUBROUTINE fld_fill( sdf, sdf_n, cdir, cdcaller, cdtitle, cdnam )897 SUBROUTINE fld_fill( sdf, sdf_n, cdir, cdcaller, cdtitle, cdnam, knoprint ) 885 898 !!--------------------------------------------------------------------- 886 899 !! *** ROUTINE fld_fill *** 887 900 !! 888 !! ** Purpose : fill sdf with sdf_n and control print 889 !!---------------------------------------------------------------------- 890 TYPE(FLD) , DIMENSION(:), INTENT(inout) :: sdf ! structure of input fields (file informations, fields read) 891 TYPE(FLD_N), DIMENSION(:), INTENT(in ) :: sdf_n ! array of namelist information structures 892 CHARACTER(len=*) , INTENT(in ) :: cdir ! Root directory for location of flx files 893 CHARACTER(len=*) , INTENT(in ) :: cdcaller ! 894 CHARACTER(len=*) , INTENT(in ) :: cdtitle ! 895 CHARACTER(len=*) , INTENT(in ) :: cdnam ! 896 ! 897 INTEGER :: jf ! dummy indices 901 !! ** Purpose : fill the data structure (sdf) with the associated information 902 !! read in namelist (sdf_n) and control print 903 !!---------------------------------------------------------------------- 904 TYPE(FLD) , DIMENSION(:) , INTENT(inout) :: sdf ! structure of input fields (file informations, fields read) 905 TYPE(FLD_N), DIMENSION(:) , INTENT(in ) :: sdf_n ! array of namelist information structures 906 CHARACTER(len=*) , INTENT(in ) :: cdir ! Root directory for location of flx files 907 CHARACTER(len=*) , INTENT(in ) :: cdcaller ! name of the calling routine 908 CHARACTER(len=*) , INTENT(in ) :: cdtitle ! description of the calling routine 909 CHARACTER(len=*) , INTENT(in ) :: cdnam ! name of the namelist from which sdf_n comes 910 INTEGER , OPTIONAL, INTENT(in ) :: knoprint ! no calling routine information printed 911 ! 912 INTEGER :: jf ! dummy indices 898 913 !!--------------------------------------------------------------------- 899 914 ! … … 922 937 IF(lwp) THEN ! control print 923 938 WRITE(numout,*) 924 WRITE(numout,*) TRIM( cdcaller )//' : '//TRIM( cdtitle ) 925 WRITE(numout,*) (/ ('~', jf = 1, LEN_TRIM( cdcaller ) ) /) 926 WRITE(numout,*) ' '//TRIM( cdnam )//' Namelist' 927 WRITE(numout,*) ' list of files and frequency (>0: in hours ; <0 in months)' 939 IF( .NOT.PRESENT( knoprint) ) THEN 940 WRITE(numout,*) TRIM( cdcaller )//' : '//TRIM( cdtitle ) 941 WRITE(numout,*) (/ ('~', jf = 1, LEN_TRIM( cdcaller ) ) /) 942 ENDIF 943 WRITE(numout,*) ' fld_fill : fill data structure with information from namelist '//TRIM( cdnam ) 944 WRITE(numout,*) ' ~~~~~~~~' 945 WRITE(numout,*) ' list of files and frequency (>0: in hours ; <0 in months)' 928 946 DO jf = 1, SIZE(sdf) 929 WRITE(numout,*) ' root filename: ' , TRIM( sdf(jf)%clrootname ), & 930 & ' variable name: ' , TRIM( sdf(jf)%clvar ) 931 WRITE(numout,*) ' frequency: ' , sdf(jf)%nfreqh , & 932 & ' time interp: ' , sdf(jf)%ln_tint , & 933 & ' climatology: ' , sdf(jf)%ln_clim , & 934 & ' weights : ' , TRIM( sdf(jf)%wgtname ), & 935 & ' pairing : ' , TRIM( sdf(jf)%vcomp ), & 936 & ' data type: ' , sdf(jf)%cltype , & 937 & ' land/sea mask:' , TRIM( sdf(jf)%lsmname ) 947 WRITE(numout,*) ' root filename: ' , TRIM( sdf(jf)%clrootname ), ' variable name: ', TRIM( sdf(jf)%clvar ) 948 WRITE(numout,*) ' frequency: ' , sdf(jf)%nfreqh , & 949 & ' time interp: ' , sdf(jf)%ln_tint , & 950 & ' climatology: ' , sdf(jf)%ln_clim 951 WRITE(numout,*) ' weights: ' , TRIM( sdf(jf)%wgtname ), & 952 & ' pairing: ' , TRIM( sdf(jf)%vcomp ), & 953 & ' data type: ' , sdf(jf)%cltype , & 954 & ' land/sea mask:' , TRIM( sdf(jf)%lsmname ) 938 955 call flush(numout) 939 956 END DO … … 947 964 !! *** ROUTINE wgt_list *** 948 965 !! 949 !! ** Purpose : search array of WGTs and find a weights file 950 !! entry, or return a new one adding it to the end 951 !! if it is a new entry, the weights data is read in and 952 !! restructured (fld_weight) 966 !! ** Purpose : search array of WGTs and find a weights file entry, 967 !! or return a new one adding it to the end if new entry. 968 !! the weights data is read in and restructured (fld_weight) 953 969 !!---------------------------------------------------------------------- 954 970 TYPE( FLD ), INTENT(in ) :: sd ! field with name of weights file … … 1019 1035 !! *** ROUTINE fld_weight *** 1020 1036 !! 1021 !! ** Purpose : create a new WGT structure and fill in data from 1022 !! file,restructuring as required1037 !! ** Purpose : create a new WGT structure and fill in data from file, 1038 !! restructuring as required 1023 1039 !!---------------------------------------------------------------------- 1024 1040 TYPE( FLD ), INTENT(in) :: sd ! field with name of weights file … … 1163 1179 1164 1180 SUBROUTINE apply_seaoverland( clmaskfile, zfieldo, jpi1_lsm, jpi2_lsm, jpj1_lsm, & 1165 &jpj2_lsm, itmpi, itmpj, itmpz, rec1_lsm, recn_lsm )1181 & jpj2_lsm, itmpi, itmpj, itmpz, rec1_lsm, recn_lsm ) 1166 1182 !!--------------------------------------------------------------------- 1167 1183 !! *** ROUTINE apply_seaoverland *** … … 1492 1508 !! *** FUNCTION kshift_week *** 1493 1509 !! 1494 !! ** Purpose : 1495 !!--------------------------------------------------------------------- 1496 CHARACTER(len=*), INTENT(in) :: cdday !3 first letters of the first day of the weekly file 1497 !! 1498 INTEGER :: ksec_week ! output variable 1499 INTEGER :: ijul !temp variable 1500 INTEGER :: ishift !temp variable 1510 !! ** Purpose : return the first 3 letters of the first day of the weekly file 1511 !!--------------------------------------------------------------------- 1512 CHARACTER(len=*), INTENT(in) :: cdday ! first 3 letters of the first day of the weekly file 1513 !! 1514 INTEGER :: ksec_week ! output variable 1515 INTEGER :: ijul, ishift ! local integer 1501 1516 CHARACTER(len=3),DIMENSION(7) :: cl_week 1502 1517 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
