Changeset 1660


Ignore:
Timestamp:
02/17/12 11:27:36 (13 years ago)
Author:
mmaipsl
Message:

Add ipsldbg management for debugging flincom.
Correct a bug in flinget_mat when readding multiple time steps.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • IOIPSL/trunk/src/flincom.f90

    r1378 r1660  
    99!- 
    1010  USE calendar,  ONLY : ju2ymds, ymds2ju, ioconf_calendar 
    11   USE errioipsl, ONLY : histerr, ipslout 
     11  USE errioipsl, ONLY : histerr, ipslout,ipslerr,ipsldbg 
    1212  USE stringop,  ONLY : strlowercase 
    1313!- 
    … …  
    175175  CHARACTER(LEN=250):: name 
    176176!- 
    177   LOGICAL :: check = .FALSE. 
    178 !--------------------------------------------------------------------- 
     177  LOGICAL :: l_dbg 
     178!--------------------------------------------------------------------- 
     179  CALL ipsldbg (old_status=l_dbg) 
     180 
    179181  lll = LEN_TRIM(filename) 
    180182  IF (filename(lll-2:lll) /= '.nc') THEN 
    … …  
    193195! Vertical axis 
    194196!- 
    195   IF (check) WRITE(ipslout,*) 'flincre Vertical axis' 
     197  IF (l_dbg) WRITE(ipslout,*) 'flincre Vertical axis' 
    196198!- 
    197199  iret = NF90_DEF_VAR (fid, 'lev', NF90_FLOAT, zdimid1, levid) 
    … …  
    202204! Time axis 
    203205!- 
    204   IF (check) WRITE(ipslout,*) 'flincre time axis' 
     206  IF (l_dbg) WRITE(ipslout,*) 'flincre time axis' 
    205207!- 
    206208  iret = NF90_DEF_VAR (fid, 'tstep', NF90_FLOAT, tdimid1, timeid) 
    … …  
    211213! The longitude 
    212214!- 
    213   IF (check) WRITE(ipslout,*) 'flincre Longitude axis' 
     215  IF (l_dbg) WRITE(ipslout,*) 'flincre Longitude axis' 
    214216!- 
    215217  iret = NF90_DEF_VAR (fid, "nav_lon", NF90_FLOAT, & 
    … …  
    226228! The Latitude 
    227229!- 
    228   IF (check) WRITE(ipslout,*) 'flincre Latitude axis' 
     230  IF (l_dbg) WRITE(ipslout,*) 'flincre Latitude axis' 
    229231!- 
    230232  iret = NF90_DEF_VAR (fid, "nav_lat", NF90_FLOAT, & 
    … …  
    253255  iret = NF90_ENDDEF (fid) 
    254256!- 
    255   IF (check) WRITE(ipslout,*) 'flincre Variable' 
     257  IF (l_dbg) WRITE(ipslout,*) 'flincre Variable' 
    256258!- 
    257259  iret = NF90_PUT_VAR (fid, levid, lev1(1:llm1)) 
    258260!- 
    259   IF (check) WRITE(ipslout,*) 'flincre Time Variable' 
     261  IF (l_dbg) WRITE(ipslout,*) 'flincre Time Variable' 
    260262!- 
    261263  iret = NF90_PUT_VAR (fid, timeid, REAL(itaus(1:ttm1))) 
    262264!- 
    263   IF (check) WRITE(ipslout,*) 'flincre Longitude' 
     265  IF (l_dbg) WRITE(ipslout,*) 'flincre Longitude' 
    264266!- 
    265267  iret = NF90_PUT_VAR (fid, lonid, lon1(1:iim1,1:jjm1)) 
    266268!- 
    267   IF (check) WRITE(ipslout,*) 'flincre Latitude' 
     269  IF (l_dbg) WRITE(ipslout,*) 'flincre Latitude' 
    268270!- 
    269271  iret = NF90_PUT_VAR (fid, latid, lat1(1:iim1,1:jjm1)) 
    … …  
    311313  INTEGER :: fid_out 
    312314!- 
    313   LOGICAL :: check = .FALSE. 
    314 !--------------------------------------------------------------------- 
    315   IF (check) WRITE (*,*) ' iideb, iilen, jjdeb, jjlen, iim, jjm ', & 
     315  LOGICAL :: l_dbg 
     316!--------------------------------------------------------------------- 
     317  CALL ipsldbg (old_status=l_dbg) 
     318 
     319  IF (l_dbg) WRITE (*,*) ' iideb, iilen, jjdeb, jjlen, iim, jjm ', & 
    316320                           iideb, iilen, jjdeb, jjlen, iim, jjm 
    317   IF (check) WRITE (*,*) ' lon ', lon(1,1), lon(iilen,jjlen) 
    318   IF (check) WRITE (*,*) ' lat ', lat(1,1), lat(iilen,jjlen) 
     321  IF (l_dbg) WRITE (*,*) ' lon ', lon(1,1), lon(iilen,jjlen) 
     322  IF (l_dbg) WRITE (*,*) ' lat ', lat(1,1), lat(iilen,jjlen) 
    319323!- 
    320324  CALL flinopen_work & 
    … …  
    388392!- 
    389393  LOGICAL :: open_file 
    390   LOGICAL :: check = .FALSE. 
    391 !--------------------------------------------------------------------- 
     394  LOGICAL :: l_dbg 
     395!--------------------------------------------------------------------- 
     396  CALL ipsldbg (old_status=l_dbg) 
     397 
    392398  iilast = iideb+iilen-1 
    393399  jjlast = jjdeb+jjlen-1 
    394   IF (check) WRITE (*,*) & 
     400  IF (l_dbg) WRITE (*,*) & 
    395401    ' flinopen_work zoom 2D information '// & 
    396402    ' iideb, iilen, iilast, jjdeb, jjlen, jjlast ', & 
    … …  
    422428  ENDIF 
    423429!- 
    424   IF (check) & 
     430  IF (l_dbg) & 
    425431    WRITE(ipslout,*) 'OUT OF flininfo :',tmp_iim,tmp_jjm,tmp_llm,tmp_ttm 
    426432!- 
    … …  
    432438! 2.2 We test the axis if we have to. 
    433439!- 
    434   IF (check) & 
     440  IF (l_dbg) & 
    435441    WRITE(ipslout,*) 'flininfo 2.2 We test if we have to test : ',do_test 
    436442!- 
    … …  
    453459!-- 2.3 Else the sizes of the axes are returned to the user 
    454460!--- 
    455     IF (check) WRITE(ipslout,*) 'flinopen 2.3 Else sizes are returned' 
     461    IF (l_dbg) WRITE(ipslout,*) 'flinopen 2.3 Else sizes are returned' 
    456462!--- 
    457463    iim = tmp_iim 
    … …  
    465471!     if not then we get the lon, lat and lev variables from the file 
    466472!- 
    467   IF (check) WRITE(ipslout,*) 'flinopen 3.0 we are realy talking' 
     473  IF (l_dbg) WRITE(ipslout,*) 'flinopen 3.0 we are realy talking' 
    468474!- 
    469475  IF (do_test) THEN 
    … …  
    473479    iret = NF90_GET_VAR (fid, vid, x_last, start=(/ iilast, jjlast /)) 
    474480!--- 
    475     IF (check) & 
     481    IF (l_dbg) & 
    476482      WRITE(ipslout,*) 'from file lon first and last, modulo 360. ', & 
    477483        x_first, x_last, MODULO(x_first,360.), MODULO(x_last,360.) 
    478     IF (check) & 
     484    IF (l_dbg) & 
    479485      WRITE(ipslout,*) 'from model lon first and last, modulo 360. ', & 
    480486        lon(1,1),lon(iilen,jjlen), & 
    … …  
    494500    iret = NF90_GET_VAR (fid, vid, x_last, start=(/ iilast, jjlast /)) 
    495501!--- 
    496     IF (check) WRITE(ipslout,*) & 
     502    IF (l_dbg) WRITE(ipslout,*) & 
    497503      'from file lat first and last ',x_first,x_last 
    498     IF (check) WRITE(ipslout,*) & 
     504    IF (l_dbg) WRITE(ipslout,*) & 
    499505      'from model lat first and last ',lat(1,1),lat(iilen,jjlen) 
    500506!--- 
    … …  
    512518      iret = NF90_GET_VAR (fid, vid, x_last, start=(/ llm /)) 
    513519!----- 
    514       IF (check) WRITE(ipslout,*) & 
     520      IF (l_dbg) WRITE(ipslout,*) & 
    515521        'from file lev first and last ',x_first ,x_last 
    516       IF (check) WRITE(ipslout,*) & 
     522      IF (l_dbg) WRITE(ipslout,*) & 
    517523        'from model lev first and last ',lev(1),lev(llm) 
    518524!----- 
    … …  
    530536!-- 4.0 extracting the coordinates if we do not check 
    531537!--- 
    532     IF (check) WRITE(ipslout,*) 'flinopen 4.0 extracting the coordinates' 
     538    IF (l_dbg) WRITE(ipslout,*) 'flinopen 4.0 extracting the coordinates' 
    533539!--- 
    534540    CALL flinfindcood (fid_out, 'lon', vid, nbdim) 
    … …  
    575581! 5.0 Get all the details for the time if possible needed 
    576582!- 
    577   IF (check) WRITE(ipslout,*) 'flinopen 5.0 Get time' 
     583  IF (l_dbg) WRITE(ipslout,*) 'flinopen 5.0 Get time' 
    578584!- 
    579585  IF (ttm > 0) THEN 
    … …  
    609615    DEALLOCATE(vec_tmp) 
    610616!--- 
    611     IF (check) WRITE(ipslout,*) 'flinopen 5.1 Times ',itaus 
     617    IF (l_dbg) WRITE(ipslout,*) 'flinopen 5.1 Times ',itaus 
    612618!--- 
    613619!-- Getting all the details for the time axis 
    … …  
    629635      sec0 = hours0*3600. + minutes0*60. + seci 
    630636      CALL ymds2ju (year0, month0, day0, sec0, date0) 
    631       IF (check) & 
     637      IF (l_dbg) & 
    632638        WRITE(ipslout,*) 'flinopen 5.1 gdtt_id year0 ... date0 ', & 
    633639                   year0, month0, day0, sec0, date0 
    … …  
    642648      CALL ymds2ju (year0, month0, day0, sec0, date0) 
    643649!----- 
    644       IF (check) & 
     650      IF (l_dbg) & 
    645651        WRITE(ipslout,*) 'flinopen 5.1 gdtmaf_id year0 ... date0 ', & 
    646652                   year0, month0, day0, sec0, date0 
    … …  
    660666  ENDIF 
    661667!- 
    662   IF (check) WRITE(ipslout,*) 'flinopen 6.0 File opened', date0, dt 
     668  IF (l_dbg) WRITE(ipslout,*) 'flinopen 6.0 File opened', date0, dt 
    663669!--------------------------- 
    664670END SUBROUTINE flinopen_work 
    … …  
    688694  CHARACTER(LEN=30) :: axname 
    689695!- 
    690   LOGICAL :: check = .FALSE. 
    691 !--------------------------------------------------------------------- 
     696  LOGICAL :: l_dbg 
     697!--------------------------------------------------------------------- 
     698  CALL ipsldbg (old_status=l_dbg) 
     699 
    692700  lll = LEN_TRIM(filename) 
    693701  IF (filename(lll-2:lll) /= '.nc') THEN 
    … …  
    716724    axname = ADJUSTL(axname) 
    717725!--- 
    718     IF (check) WRITE(ipslout,*) & 
     726    IF (l_dbg) WRITE(ipslout,*) & 
    719727      'flininfo - getting axname',iv,axname,lll 
    720728!--- 
    … …  
    778786!- 
    779787  INTEGER :: fid, ncvarid, ndim, iret 
    780   LOGICAL :: check = .FALSE. 
    781 !--------------------------------------------------------------------- 
    782   IF (check) WRITE(ipslout,*) & 
     788  LOGICAL :: l_dbg 
     789!--------------------------------------------------------------------- 
     790  CALL ipsldbg (old_status=l_dbg) 
     791 
     792  IF (l_dbg) WRITE(ipslout,*) & 
    783793     "flinput_r1d : SIZE(var) = ",SIZE(var) 
    784794!- 
    … …  
    805815!- 
    806816  INTEGER :: fid, ncvarid, ndim, iret 
    807   LOGICAL :: check = .FALSE. 
    808 !--------------------------------------------------------------------- 
    809   IF (check) WRITE(ipslout,*) & 
     817  LOGICAL :: l_dbg 
     818!--------------------------------------------------------------------- 
     819  CALL ipsldbg (old_status=l_dbg) 
     820 
     821  IF (l_dbg) WRITE(ipslout,*) & 
    810822     "flinput_r2d : SIZE(var) = ",SIZE(var) 
    811823!- 
    … …  
    832844!- 
    833845  INTEGER :: fid, ncvarid, ndim, iret 
    834   LOGICAL :: check = .FALSE. 
    835 !--------------------------------------------------------------------- 
    836   IF (check) WRITE(ipslout,*) & 
     846  LOGICAL :: l_dbg 
     847!--------------------------------------------------------------------- 
     848  CALL ipsldbg (old_status=l_dbg) 
     849 
     850  IF (l_dbg) WRITE(ipslout,*) & 
    837851     "flinput_r3d : SIZE(var) = ",SIZE(var) 
    838852!- 
    … …  
    859873!- 
    860874  INTEGER :: fid, ncvarid, ndim, iret 
    861   LOGICAL :: check = .FALSE. 
    862 !--------------------------------------------------------------------- 
    863   IF (check) WRITE(ipslout,*) & 
     875  LOGICAL :: l_dbg 
     876!--------------------------------------------------------------------- 
     877  CALL ipsldbg (old_status=l_dbg) 
     878 
     879  IF (l_dbg) WRITE(ipslout,*) & 
    864880     "flinput_r4d : SIZE(var) = ",SIZE(var) 
    865881!- 
    … …  
    958974  INTEGER :: jl, ji 
    959975  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp 
    960   LOGICAL :: check = .FALSE. 
    961 !--------------------------------------------------------------------- 
     976  LOGICAL :: l_dbg 
     977!--------------------------------------------------------------------- 
     978  CALL ipsldbg (old_status=l_dbg) 
     979 
    962980  IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    963     IF (check) WRITE(ipslout,*) & 
     981    IF (l_dbg) WRITE(ipslout,*) & 
    964982      "flinget_r1d : allocate buff_tmp for buff_sz = ",SIZE(var) 
    965983    ALLOCATE (buff_tmp(SIZE(var))) 
    966984  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 
    967     IF (check) WRITE(ipslout,*) & 
     985    IF (l_dbg) WRITE(ipslout,*) & 
    968986      "flinget_r1d : re-allocate buff_tmp for buff_sz = ",SIZE(var) 
    969987    DEALLOCATE (buff_tmp) 
    … …  
    9961014  INTEGER :: jl, jj, ji 
    9971015  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp 
    998   LOGICAL :: check = .FALSE. 
    999 !--------------------------------------------------------------------- 
     1016  LOGICAL :: l_dbg 
     1017!--------------------------------------------------------------------- 
     1018  CALL ipsldbg (old_status=l_dbg) 
     1019 
    10001020  IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    1001     IF (check) WRITE(ipslout,*) & 
     1021    IF (l_dbg) WRITE(ipslout,*) & 
    10021022      "flinget_r2d : allocate buff_tmp for buff_sz = ",SIZE(var) 
    10031023    ALLOCATE (buff_tmp(SIZE(var))) 
    10041024  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 
    1005     IF (check) WRITE(ipslout,*) & 
     1025    IF (l_dbg) WRITE(ipslout,*) & 
    10061026      "flinget_r2d : re-allocate buff_tmp for buff_sz = ",SIZE(var) 
    10071027    DEALLOCATE (buff_tmp) 
    … …  
    10371057  INTEGER :: jl, jj, ji 
    10381058  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp 
    1039   LOGICAL :: check = .FALSE. 
    1040 !--------------------------------------------------------------------- 
     1059  LOGICAL :: l_dbg 
     1060!--------------------------------------------------------------------- 
     1061  CALL ipsldbg (old_status=l_dbg) 
     1062 
    10411063  IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    1042     IF (check) WRITE(ipslout,*) & 
     1064    IF (l_dbg) WRITE(ipslout,*) & 
    10431065      "flinget_r2d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var) 
    10441066    ALLOCATE (buff_tmp(SIZE(var))) 
    10451067  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 
    1046     IF (check) WRITE(ipslout,*) & 
     1068    IF (l_dbg) WRITE(ipslout,*) & 
    10471069      "flinget_r2d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var) 
    10481070    DEALLOCATE (buff_tmp) 
    … …  
    10771099  INTEGER :: jl, jk, jj, ji 
    10781100  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp 
    1079   LOGICAL :: check = .FALSE. 
    1080 !--------------------------------------------------------------------- 
     1101  LOGICAL :: l_dbg 
     1102!--------------------------------------------------------------------- 
     1103  CALL ipsldbg (old_status=l_dbg) 
     1104 
    10811105  IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    1082     IF (check) WRITE(ipslout,*) & 
     1106    IF (l_dbg) WRITE(ipslout,*) & 
    10831107      "flinget_r3d : allocate buff_tmp for buff_sz = ",SIZE(var) 
    10841108    ALLOCATE (buff_tmp(SIZE(var))) 
    10851109  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 
    1086     IF (check) WRITE(ipslout,*) & 
     1110    IF (l_dbg) WRITE(ipslout,*) & 
    10871111      "flinget_r3d : re-allocate buff_tmp for buff_sz = ",SIZE(var) 
    10881112    DEALLOCATE (buff_tmp) 
    … …  
    11201144  INTEGER :: jl, jk, jj, ji 
    11211145  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp 
    1122   LOGICAL :: check = .FALSE. 
    1123 !--------------------------------------------------------------------- 
     1146  LOGICAL :: l_dbg 
     1147!--------------------------------------------------------------------- 
     1148  CALL ipsldbg (old_status=l_dbg) 
     1149 
    11241150  IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    1125     IF (check) WRITE(ipslout,*) & 
     1151    IF (l_dbg) WRITE(ipslout,*) & 
    11261152      "flinget_r3d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var) 
    11271153    ALLOCATE (buff_tmp(SIZE(var))) 
    11281154  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 
    1129     IF (check) WRITE(ipslout,*) & 
     1155    IF (l_dbg) WRITE(ipslout,*) & 
    11301156      "flinget_r3d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var) 
    11311157    DEALLOCATE (buff_tmp) 
    … …  
    11621188  INTEGER :: jl, jk, jj, ji, jm 
    11631189  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp 
    1164   LOGICAL :: check = .FALSE. 
    1165 !--------------------------------------------------------------------- 
     1190  LOGICAL :: l_dbg 
     1191!--------------------------------------------------------------------- 
     1192  CALL ipsldbg (old_status=l_dbg) 
     1193 
    11661194  IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    1167     IF (check) WRITE(ipslout,*) & 
     1195    IF (l_dbg) WRITE(ipslout,*) & 
    11681196      "flinget_r4d : allocate buff_tmp for buff_sz = ",SIZE(var) 
    11691197    ALLOCATE (buff_tmp(SIZE(var))) 
    11701198  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 
    1171     IF (check) WRITE(ipslout,*) & 
     1199    IF (l_dbg) WRITE(ipslout,*) & 
    11721200      "flinget_r4d : re-allocate buff_tmp for buff_sz = ",SIZE(var) 
    11731201    DEALLOCATE (buff_tmp) 
    … …  
    12071235  INTEGER :: jl, jk, jj, ji, jm 
    12081236  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp 
    1209   LOGICAL :: check = .FALSE. 
    1210 !--------------------------------------------------------------------- 
     1237  LOGICAL :: l_dbg 
     1238!--------------------------------------------------------------------- 
     1239  CALL ipsldbg (old_status=l_dbg) 
     1240 
    12111241  IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    1212     IF (check) WRITE(ipslout,*) & 
     1242    IF (l_dbg) WRITE(ipslout,*) & 
    12131243      "flinget_r4d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var) 
    12141244    ALLOCATE (buff_tmp(SIZE(var))) 
    12151245  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 
    1216     IF (check) WRITE(ipslout,*) & 
     1246    IF (l_dbg) WRITE(ipslout,*) & 
    12171247      "flinget_r4d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var) 
    12181248    DEALLOCATE (buff_tmp) 
    … …  
    12831313! ARGUMENTS 
    12841314!- 
    1285   INTEGER :: fid_in 
    1286   CHARACTER(LEN=*) :: varname 
    1287   INTEGER :: iim, jjm, llm, ttm 
    1288   INTEGER :: itau_dep, itau_fin, iideb, iilen, jjdeb, jjlen 
    1289   REAL :: var(:) 
     1315  INTEGER, INTENT(IN) :: fid_in 
     1316  CHARACTER(LEN=*), INTENT(IN) :: varname 
     1317  INTEGER, INTENT(IN) :: iim, jjm, llm, ttm 
     1318  INTEGER, INTENT(IN) :: itau_dep, itau_fin, iideb, iilen, jjdeb, jjlen 
     1319  REAL, INTENT(OUT) :: var(:) 
    12901320!- 
    12911321! LOCAL 
    … …  
    13031333  INTEGER :: i, nvars, i2d, cnd 
    13041334  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: var_tmp 
     1335  INTEGER :: itau_len 
    13051336  LOGICAL :: uncompress = .FALSE. 
    1306   LOGICAL :: check = .FALSE. 
    1307 !--------------------------------------------------------------------- 
     1337  INTEGER :: il, ip, i2p, it 
     1338  !- 
     1339  LOGICAL :: l_dbg 
     1340!--------------------------------------------------------------------- 
     1341  CALL ipsldbg (old_status=l_dbg) 
     1342  !- 
    13081343  fid = ncids(fid_in) 
    13091344!- 
    1310   IF (check) THEN 
     1345  IF (l_dbg) THEN 
    13111346    WRITE(ipslout,*) & 
    13121347    'flinget_mat : fid_in, fid, varname :', fid_in, fid, TRIM(varname) 
    … …  
    13351370  iret = NF90_INQUIRE_VARIABLE (fid, vid, & 
    13361371           ndims=ndims, dimids=dimids, nAtts=nb_atts) 
    1337   IF (check) THEN 
     1372  IF (l_dbg) THEN 
    13381373    WRITE(ipslout,*) & 
    13391374    'flinget_mat : fid, vid :', fid, vid 
    … …  
    13471382    iret  = NF90_INQUIRE_DIMENSION (fid, dimids(i), len=w_dim(i)) 
    13481383  ENDDO 
    1349   IF (check) WRITE(ipslout,*) & 
     1384  IF (l_dbg) WRITE(ipslout,*) & 
    13501385    'flinget_mat : w_dim :', w_dim(1:ndims) 
    13511386!- 
    … …  
    13531388!- 
    13541389  IF (nb_atts > 0) THEN 
    1355     IF (check) THEN 
     1390     IF (l_dbg) THEN 
    13561391      WRITE(ipslout,*) 'flinget_mat : attributes for variable :' 
    13571392    ENDIF 
    … …  
    13641399             .OR.(x_typ == NF90_BYTE) ) THEN 
    13651400      iret = NF90_GET_ATT (fid, vid, att_n, tmp_i) 
    1366       IF (check) THEN 
     1401        IF (l_dbg) THEN 
    13671402        WRITE(ipslout,*) '   ',TRIM(att_n),' : ',tmp_i 
    13681403      ENDIF 
    13691404    ELSE IF ( (x_typ == NF90_FLOAT).OR.(x_typ == NF90_DOUBLE) ) THEN 
    13701405      iret = NF90_GET_ATT (fid, vid, att_n, tmp_r) 
    1371       IF (check) THEN 
     1406        IF (l_dbg) THEN 
    13721407        WRITE(ipslout,*) '   ',TRIM(att_n),' : ',tmp_r 
    13731408      ENDIF 
    … …  
    13781413      tmp_n = '' 
    13791414      iret = NF90_GET_ATT (fid, vid, att_n, tmp_n) 
    1380       IF (check) THEN 
     1415        IF (l_dbg) THEN 
    13811416        WRITE(ipslout,*) '   ',TRIM(att_n),' : ',TRIM(tmp_n) 
    13821417      ENDIF 
    … …  
    14021437    iret = NF90_INQ_VARID (fid, tmp_n, cvid) 
    14031438!--- 
    1404     IF (check) WRITE(ipslout,*) & 
     1439    IF (l_dbg) WRITE(ipslout,*) & 
    14051440      'Dimname, iret , NF90_NOERR : ',TRIM(tmp_n),iret,NF90_NOERR 
    14061441!--- 
    … …  
    15591594! 3.0 Reading the data 
    15601595!- 
    1561   IF (check) WRITE(ipslout,*) & 
     1596  IF (l_dbg) WRITE(ipslout,*) & 
    15621597    'flinget_mat 3.0 : ', uncompress, w_sta, w_len 
    15631598!--- 
     1599  var(:) = mis_v 
    15641600  IF (uncompress) THEN 
    15651601!--- 
    15661602    IF (ALLOCATED(var_tmp)) THEN 
    1567       IF (SIZE(var_tmp) < clen) THEN 
    1568         DEALLOCATE(var_tmp) 
    1569         ALLOCATE(var_tmp(clen)) 
     1603      IF (SIZE(var_tmp) < PRODUCT(w_len(:),mask=(w_len>1))) THEN 
     1604         DEALLOCATE(var_tmp) 
     1605         ALLOCATE(var_tmp(PRODUCT(w_len(:),mask=(w_len>1)))) 
    15701606      ENDIF 
    15711607    ELSE 
    1572       ALLOCATE(var_tmp(clen)) 
     1608      ALLOCATE(var_tmp(PRODUCT(w_len(:),mask=(w_len>1)))) 
    15731609    ENDIF 
    15741610!--- 
    … …  
    15761612             start=w_sta(:), count=w_len(:)) 
    15771613!--- 
     1614    itau_len=itau_fin-itau_dep+1 
     1615    IF (l_dbg) WRITE(ipslout,*) 'flinget_mat 3.0 : clen, itau_len ',clen,itau_len 
    15781616    var(:) = mis_v 
    1579     var(cindex(:)) = var_tmp(:) 
     1617    IF (itau_len > 0) THEN 
     1618       DO it=1,itau_len 
     1619          DO il=1,clen 
     1620             ip = il + (it-1)*clen 
     1621             i2p = cindex(il)+(it-1)*iim*jjm 
     1622             var(i2p) = var_tmp(ip) 
     1623          ENDDO 
     1624       ENDDO 
     1625    ELSE 
     1626       var(cindex(:)) = var_tmp(:) 
     1627    ENDIF 
    15801628!--- 
    15811629  ELSE 
    … …  
    15841632  ENDIF 
    15851633!- 
    1586   IF (check) WRITE(ipslout,*) 'flinget_mat 3.1 : ',NF90_STRERROR (iret) 
     1634  IF (l_dbg) WRITE(ipslout,*) 'flinget_mat 3.1 : ',NF90_STRERROR (iret) 
    15871635!-------------------------- 
    15881636END  SUBROUTINE flinget_mat 
    … …  
    16321680  INTEGER :: iret, fid 
    16331681!- 
    1634   LOGICAL :: check = .FALSE. 
    1635 !--------------------------------------------------------------------- 
    1636   IF (check) THEN 
     1682  LOGICAL :: l_dbg 
     1683!--------------------------------------------------------------------- 
     1684  CALL ipsldbg (old_status=l_dbg) 
     1685 
     1686  IF (l_dbg) THEN 
    16371687    WRITE (*,*) 'flinget_scal in file with id ',fid_in 
    16381688  ENDIF 
Note: See TracChangeset for help on using the changeset viewer.