Changeset 428 for IOIPSL


Ignore:
Timestamp:
10/21/08 14:35:32 (16 years ago)
Author:
bellier
Message:

some bugfixes

Location:
IOIPSL/trunk/src
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • IOIPSL/trunk/src/calendar.f90

    r386 r428  
    651651!--------------------------------------------------------------------- 
    652652!- 
    653 ! Clean up the sring ! 
     653! Clean up the string ! 
    654654!- 
    655655  str_w = str 
    … …  
    701701      ENDIF 
    702702    END SELECT 
    703   ELSE 
     703  ELSE IF (TRIM(str_w) /= TRIM(calendar_used)) THEN 
    704704    WRITE(str_w,'(f10.4)') one_year 
    705705    CALL ipslerr (2,'ioconf_calendar', & 
    706  &   'The calendar was already used or configured. You are not', & 
    707  &   'allowed to change it again. '// & 
    708  &   'The following length of year is used : ',TRIM(ADJUSTL(str_w))) 
     706 &   'The calendar was already used or configured to : '// & 
     707 &    TRIM(calendar_used)//'.', & 
     708 &   'You are not allowed to change it to : '//TRIM(str)//'.', & 
     709 &   'The following length of year is used : '//TRIM(ADJUSTL(str_w))) 
    709710  ENDIF 
    710711!----------------------------- 

  • IOIPSL/trunk/src/restcom.f90

    r386 r428  
    88USE netcdf 
    99!- 
    10 USE errioipsl, ONLY : ipslerr 
     10USE errioipsl, ONLY : ipslerr,ipsldbg 
    1111USE stringop 
    1212USE calendar 
    … …  
    212212  INTEGER,INTENT(IN),OPTIONAL :: domain_id 
    213213!- 
    214 ! LOCAL 
    215 !- 
    216214  INTEGER :: ncfid 
    217215  REAL :: dt_tmp,date0_tmp 
    … …  
    219217  LOGICAL :: overwrite_time 
    220218  CHARACTER(LEN=120) :: fname 
    221   LOGICAL :: check = .FALSE. 
    222 !--------------------------------------------------------------------- 
     219  LOGICAL :: l_dbg 
     220!--------------------------------------------------------------------- 
     221  CALL ipsldbg (old_status=l_dbg) 
    223222!- 
    224223! 0.0 Prepare the configuration before opening any files 
    … …  
    230229  ENDIF 
    231230!- 
    232   IF (check) THEN 
     231  IF (l_dbg) THEN 
    233232    WRITE(*,*) 'restini 0.0 : ',TRIM(fnamein),' , ',TRIM(fnameout) 
    234233  ENDIF 
    … …  
    254253  l_rw = l_fi.AND.l_fo.AND.(TRIM(fnamein) == TRIM(fnameout)) 
    255254!- 
    256   IF (check) THEN 
     255  IF (l_dbg) THEN 
    257256    WRITE(*,*) 'restini 0.1 l_fi, l_fo, l_rw : ',l_fi,l_fo,l_rw 
    258257  ENDIF 
    … …  
    262261  IF (l_fi) THEN 
    263262!--- 
    264     IF (check) WRITE(*,*) 'restini 1.0 : Open input file' 
     263    IF (l_dbg) WRITE(*,*) 'restini 1.0 : Open input file' 
    265264!-- Add DOMAIN number and ".nc" suffix in file names if needed 
    266265    fname = fnamein 
    … …  
    285284!-- 2.0 The case of a missing restart file is dealt with 
    286285!--- 
    287     IF (check) WRITE(*,*) 'restini 2.0' 
     286    IF (l_dbg) WRITE(*,*) 'restini 2.0' 
    288287!--- 
    289288    IF (     (ALL(MINLOC(lon(:iim,:jjm)) == MAXLOC(lon(:iim,:jjm)))) & 
    … …  
    312311!--- 
    313312    tax_size_in(nb_fi) = 1 
    314     CALL rest_atim (check,'restini') 
     313    CALL rest_atim (l_dbg,'restini') 
    315314    t_index(nb_fi,1) = itau 
    316315    t_julian(nb_fi,1) = date0 
    … …  
    340339!     (to be modified in ioconf_calendar) 
    341340!- 
    342   IF (check) THEN 
     341  IF (l_dbg) THEN 
    343342    WRITE(*,*) 'restini 2.3 : Configure calendar if needed : ', & 
    344343                calend_str 
    … …  
    347346  IF (INDEX(calend_str,'unknown') < 1) THEN 
    348347    CALL ioconf_calendar (calend_str) 
    349     IF (check) THEN 
     348    IF (l_dbg) THEN 
    350349      WRITE(*,*) 'restini 2.3b : new calendar : ',calend_str 
    351350    ENDIF 
    … …  
    359358!- 
    360359  fid = nb_fi 
    361   IF (check) THEN 
     360  IF (l_dbg) THEN 
    362361    WRITE(*,*) 'SIZE of t_index :',SIZE(t_index), & 
    363362               SIZE(t_index,dim=1),SIZE(t_index,dim=2) 
    … …  
    366365  itau = t_index(fid,1) 
    367366!- 
    368   IF (check) WRITE(*,*) 'restini END' 
     367  IF (l_dbg) WRITE(*,*) 'restini END' 
    369368!--------------------- 
    370369END SUBROUTINE restini 
    … …  
    387386  LOGICAL,INTENT(IN) :: l_rw 
    388387  INTEGER,INTENT(OUT) :: ncfid 
    389 !- 
    390 ! LOCAL 
    391388!- 
    392389  INTEGER,DIMENSION(max_dim) :: var_dims,dimlen 
    … …  
    399396  CHARACTER(LEN=80) :: units 
    400397  CHARACTER(LEN=NF90_max_name),DIMENSION(max_dim) :: dimname 
    401   LOGICAL :: check = .FALSE. 
    402 !--------------------------------------------------------------------- 
     398  LOGICAL :: l_dbg 
     399!--------------------------------------------------------------------- 
     400  CALL ipsldbg (old_status=l_dbg) 
    403401!- 
    404402! If we reuse the same file for input and output 
    … …  
    411409  ENDIF 
    412410!- 
    413   IF (check) WRITE (*,*) "restopenin 0.0 ",TRIM(fname) 
     411  IF (l_dbg) WRITE (*,*) "restopenin 0.0 ",TRIM(fname) 
    414412  iret = NF90_INQUIRE(ncfid,nDimensions=nb_dim, & 
    415413 &         nVariables=nb_var,unlimitedDimId=id_unl) 
    … …  
    435433    iret = NF90_INQUIRE_DIMENSION(ncfid,id, & 
    436434 &           len=dimlen(id),name=dimname(id)) 
    437     IF (check) THEN 
     435    IF (l_dbg) THEN 
    438436      WRITE (*,*) "restopenin 0.0 dimname",id,TRIM(dimname(id)) 
    439437    ENDIF 
    440438    IF      (TRIM(dimname(id)) == 'x') THEN 
    441439      iread = dimlen(id) 
    442       IF (check) WRITE (*,*) "iread",iread 
     440      IF (l_dbg) WRITE (*,*) "iread",iread 
    443441    ELSE IF (TRIM(dimname(id)) == 'y') THEN 
    444442      jread = dimlen(id) 
    445       IF (check) WRITE (*,*) "jread",jread 
     443      IF (l_dbg) WRITE (*,*) "jread",jread 
    446444    ELSE IF (TRIM(dimname(id)) == 'z') THEN 
    447445      lread = dimlen(id) 
    448       IF (check) WRITE (*,*) "lread",lread 
     446      IF (l_dbg) WRITE (*,*) "lread",lread 
    449447    ENDIF 
    450448  ENDDO 
    … …  
    460458      itau_out(fid) = -1 
    461459      tdimid_out(fid) =  tdimid_in(fid) 
    462       IF (check) THEN 
     460      IF (l_dbg) THEN 
    463461        WRITE (*,*) & 
    464462 &       "restopenin 0.0 unlimited axis dimname", & 
    … …  
    504502! 2.0 Get the list of variables 
    505503!- 
    506   IF (check) WRITE(*,*) 'restopenin 1.2' 
     504  IF (l_dbg) WRITE(*,*) 'restopenin 1.2' 
    507505!- 
    508506  lat_vid = -1 
    … …  
    549547!-- 2.3 Catch longitude and latitude variables 
    550548!--- 
    551     IF (INDEX(units,'degrees_nort') >= 1) THEN 
     549    IF      (INDEX(units,'degrees_nort') > 0) THEN 
    552550      lat_vid = iv 
    553     ENDIF 
    554     IF (INDEX(units,'degrees_east') >= 1) THEN 
     551    ELSE IF (INDEX(units,'degrees_east') > 0) THEN 
    555552      lon_vid = iv 
    556553    ENDIF 
    … …  
    635632  LOGICAL,OPTIONAL :: owrite_time_in 
    636633!- 
    637 ! LOCAL 
    638 !- 
    639634  INTEGER :: ncfid,iret,it,iax,iv 
    640635  CHARACTER(LEN=80) :: itau_orig,tax_orig,calendar 
    … …  
    644639  CHARACTER :: strc 
    645640  LOGICAL :: ow_time 
    646 !- 
    647   LOGICAL :: check = .FALSE. 
    648 !--------------------------------------------------------------------- 
     641  LOGICAL :: l_dbg 
     642!--------------------------------------------------------------------- 
     643  CALL ipsldbg (old_status=l_dbg) 
     644!- 
    649645  IF (PRESENT(owrite_time_in)) THEN 
    650646    ow_time = owrite_time_in 
    … …  
    657653! Allocate the space we need for the time axes 
    658654!- 
    659   CALL rest_atim (check,'restsett') 
     655  CALL rest_atim (l_dbg,'restsett') 
    660656!- 
    661657! Get the calendar if possible. Else it will be gregorian. 
    … …  
    665661    IF (iret == NF90_NOERR) THEN 
    666662      CALL ioconf_calendar (calendar) 
    667       IF (check) THEN 
     663      IF (l_dbg) THEN 
    668664        WRITE(*,*) 'restsett : calendar of the restart ',calendar 
    669665      ENDIF 
    … …  
    671667  ENDIF 
    672668  CALL ioget_calendar (one_year,one_day) 
    673   IF (check) THEN 
     669  IF (l_dbg) THEN 
    674670    WRITE(*,*) 'one_year,one_day = ',one_year,one_day 
    675671  ENDIF 
    … …  
    683679    IF (ow_time) THEN 
    684680      t_index(nb_fi,:) = itau 
    685       IF (check) THEN 
     681      IF (l_dbg) THEN 
    686682        WRITE(*,*) "nb_fi,t_index",nb_fi,t_index(nb_fi,:) 
    687683      ENDIF 
    … …  
    693689      seci = NINT(sec0) 
    694690      strc=':' 
    695       IF (check) THEN 
     691      IF (l_dbg) THEN 
    696692        WRITE(*,*) date0 
    697693        WRITE (UNIT=itau_orig,FMT='(I4.4,5(A,I2.2))') & 
    … …  
    701697    ELSE 
    702698      iret = NF90_GET_VAR(ncfid,tind_varid_in(nb_fi),t_index(nb_fi,:)) 
    703       IF (check) THEN 
     699      IF (l_dbg) THEN 
    704700        WRITE(*,*) "restsett, time axis : ",t_index(nb_fi,:) 
    705701      ENDIF 
    … …  
    728724    tax_orig = tax_orig(INDEX(tax_orig,'since')+6:LEN_TRIM(tax_orig)) 
    729725    iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'calendar',tmp_cal) 
    730     IF (check) THEN 
     726    IF (l_dbg) THEN 
    731727      WRITE(*,*) 'restsett : tmp_calendar of the restart ',tmp_cal 
    732728    ENDIF 
    733729!--- 
    734730    CALL strlowercase (tmp_cal) 
    735     IF (INDEX(calend_str,tmp_cal) < 0) THEN 
     731    IF (INDEX(calend_str,tmp_cal) < 1) THEN 
    736732      IF (INDEX(calend_str,'unknown') > 0) THEN 
    737733        calend_str = tmp_cal 
    … …  
    746742!-- to get ride of the intial date. 
    747743!--- 
    748     IF (check) WRITE(*,*) 'tax_orig : ',TRIM(tax_orig) 
     744    IF (l_dbg) WRITE(*,*) 'tax_orig : ',TRIM(tax_orig) 
    749745    READ (UNIT=tax_orig,FMT='(I4.4,5(a,I2.2))') & 
    750746      year0,strc,month0,strc,day0,strc, & 
    … …  
    757753!- 
    758754  IF (     (INDEX(itau_orig,'XXXXX') > 0) & 
    759       .AND.(INDEX(tax_orig,'XXXXX')  < 0) ) THEN 
     755      .AND.(INDEX(tax_orig,'XXXXX')  < 1) ) THEN 
    760756!!- Compute the t_itau from the date read and the timestep in the input 
    761757  ENDIF 
    762758!- 
    763759  IF (     (INDEX(tax_orig,'XXXXX')  > 0) & 
    764       .AND.(INDEX(itau_orig,'XXXXX') < 0) ) THEN 
     760      .AND.(INDEX(itau_orig,'XXXXX') < 1) ) THEN 
    765761    DO it=1,tax_size_in(nb_fi) 
    766762      t_julian(nb_fi,it) = itau2date(t_index(nb_fi,it),date0,timestep) 
    … …  
    819815  INTEGER,INTENT(IN),OPTIONAL :: domain_id 
    820816!- 
    821 ! LOCAL 
    822 !- 
    823817  INTEGER :: iret 
    824818  CHARACTER(LEN=70) :: str_t 
    … …  
    831825            'JUL','AUG','SEP','OCT','NOV','DEC'/) 
    832826  CHARACTER(LEN=30) :: timenow 
    833   LOGICAL :: check = .FALSE. 
    834 !--------------------------------------------------------------------- 
    835   IF (check) WRITE(*,*) "restopenout 0.0 ",TRIM(fname) 
     827  LOGICAL :: l_dbg 
     828!--------------------------------------------------------------------- 
     829  CALL ipsldbg (old_status=l_dbg) 
     830!- 
     831  IF (l_dbg) WRITE(*,*) "restopenout 0.0 ",TRIM(fname) 
    836832!- 
    837833!  If we use the same file for input and output 
    … …  
    865861! 1.0 Longitude 
    866862!- 
    867   IF (check) WRITE(*,*) "restopenout 1.0" 
     863  IF (l_dbg) WRITE(*,*) "restopenout 1.0" 
    868864!- 
    869865  iret = NF90_DEF_VAR(ncfid,"nav_lon",NF90_FLOAT,(/x_id,y_id/),nlonid) 
    … …  
    875871! 2.0 Latitude 
    876872!- 
    877   IF (check) WRITE(*,*) "restopenout 2.0" 
     873  IF (l_dbg) WRITE(*,*) "restopenout 2.0" 
    878874!- 
    879875  iret = NF90_DEF_VAR(ncfid,"nav_lat",NF90_FLOAT,(/x_id,y_id/),nlatid) 
    … …  
    885881! 3.0 Levels 
    886882!- 
    887   IF (check) WRITE(*,*) "restopenout 3.0" 
     883  IF (l_dbg) WRITE(*,*) "restopenout 3.0" 
    888884!- 
    889885  iret = NF90_DEF_VAR(ncfid,"nav_lev",NF90_FLOAT,z_id,nlevid) 
    … …  
    897893! 4.0 Time axis, this is the seconds since axis 
    898894!- 
    899   IF (check) WRITE(*,*) "restopenout 4.0" 
     895  IF (l_dbg) WRITE(*,*) "restopenout 4.0" 
    900896!- 
    901897  iret = NF90_DEF_VAR(ncfid,"time",NF90_FLOAT, & 
    … …  
    925921! 5.0 Time axis, this is the time steps since axis 
    926922!- 
    927   IF (check) WRITE(*,*) "restopenout 5.0" 
     923  IF (l_dbg) WRITE(*,*) "restopenout 5.0" 
    928924!- 
    929925  iret = NF90_DEF_VAR(ncfid,"time_steps",NF90_INT, & 
    … …  
    986982  iret = NF90_REDEF(ncfid) 
    987983!- 
    988   IF (check) WRITE(*,*) "restopenout END" 
     984  IF (l_dbg) WRITE(*,*) "restopenout END" 
    989985!------------------------- 
    990986END SUBROUTINE restopenout 
    … …  
    10081004  INTEGER :: nbindex,ijndex(nbindex) 
    10091005!- 
    1010 ! LOCAL 
    1011 !- 
    10121006  INTEGER :: req_sz,siz1 
    10131007  REAL :: scal 
    10141008  CHARACTER(LEN=7) :: topp 
    1015   LOGICAL :: check = .FALSE. 
    1016 !--------------------------------------------------------------------- 
     1009  LOGICAL :: l_dbg 
     1010!--------------------------------------------------------------------- 
     1011  CALL ipsldbg (old_status=l_dbg) 
    10171012!- 
    10181013! 0.0 What size should be the data in the file 
    … …  
    10331028!- 
    10341029  siz1 = SIZE(var) 
    1035   CALL rest_alloc (1,siz1,check,'restget_opp_r1d') 
    1036   CALL rest_alloc (2,req_sz,check,'restget_opp_r1d') 
     1030  CALL rest_alloc (1,siz1,l_dbg,'restget_opp_r1d') 
     1031  CALL rest_alloc (2,req_sz,l_dbg,'restget_opp_r1d') 
    10371032!- 
    10381033! 2.0 Here we get the variable from the restart file 
    … …  
    10781073  INTEGER :: nbindex,ijndex(nbindex) 
    10791074!- 
    1080 ! LOCAL 
    1081 !- 
    10821075  INTEGER :: jj,req_sz,ist,var_sz,siz1 
    10831076  REAL :: scal 
    10841077  CHARACTER(LEN=7) :: topp 
    1085   LOGICAL :: check = .FALSE. 
    1086 !--------------------------------------------------------------------- 
     1078  LOGICAL :: l_dbg 
     1079!--------------------------------------------------------------------- 
     1080  CALL ipsldbg (old_status=l_dbg) 
    10871081!- 
    10881082! 0.0 What size should be the data in the file 
    … …  
    11081102!- 
    11091103  siz1 = SIZE(var,1) 
    1110   CALL rest_alloc (1,siz1,check,'restget_opp_r2d') 
    1111   CALL rest_alloc (2,req_sz*jjm,check,'restget_opp_r2d') 
     1104  CALL rest_alloc (1,siz1,l_dbg,'restget_opp_r2d') 
     1105  CALL rest_alloc (2,req_sz*jjm,l_dbg,'restget_opp_r2d') 
    11121106!- 
    11131107! 2.0 Here we get the full variable from the restart file 
    … …  
    11521146  REAL :: var(:) 
    11531147!- 
    1154 ! LOCAL 
    1155 !- 
    11561148  INTEGER :: ji,jl,req_sz,var_sz,siz1 
    11571149  CHARACTER(LEN=70) :: str,str2 
    1158   LOGICAL :: check = .FALSE. 
    1159 !--------------------------------------------------------------------- 
     1150  LOGICAL :: l_dbg 
     1151!--------------------------------------------------------------------- 
     1152  CALL ipsldbg (old_status=l_dbg) 
    11601153!- 
    11611154! 1.0 Allocate the temporary buffer we need 
    … …  
    11641157  siz1 = SIZE(var) 
    11651158  var_sz = siz1 
    1166   CALL rest_alloc (1,var_sz,check,'restget_r1d') 
     1159  CALL rest_alloc (1,var_sz,l_dbg,'restget_r1d') 
    11671160!- 
    11681161! 2.0 Here we could check if the sizes specified agree 
    … …  
    12161209  REAL :: var(:,:) 
    12171210!- 
    1218 ! LOCAL 
    1219 !- 
    12201211  INTEGER :: ji,jj,jl,req_sz,var_sz,siz1,siz2 
    12211212  CHARACTER(LEN=70) :: str,str2 
    1222   LOGICAL :: check = .FALSE. 
    1223 !--------------------------------------------------------------------- 
     1213  LOGICAL :: l_dbg 
     1214!--------------------------------------------------------------------- 
     1215  CALL ipsldbg (old_status=l_dbg) 
    12241216!- 
    12251217! 1.0 Allocate the temporary buffer we need 
    … …  
    12291221  siz2 = SIZE(var,2) 
    12301222  var_sz = siz1*siz2 
    1231   CALL rest_alloc (1,var_sz,check,'restget_r2d') 
     1223  CALL rest_alloc (1,var_sz,l_dbg,'restget_r2d') 
    12321224!- 
    12331225! 2.0 Here we check if the sizes specified agree 
    … …  
    12841276  REAL :: var(:,:,:) 
    12851277!- 
    1286 ! LOCAL 
    1287 !- 
    12881278  INTEGER :: ji,jj,jk,jl,req_sz,var_sz,siz1,siz2,siz3 
    12891279  CHARACTER(LEN=70) :: str,str2 
    1290   LOGICAL :: check = .FALSE. 
    1291 !--------------------------------------------------------------------- 
     1280  LOGICAL :: l_dbg 
     1281!--------------------------------------------------------------------- 
     1282  CALL ipsldbg (old_status=l_dbg) 
    12921283!- 
    12931284! 1.0 Allocate the temporary buffer we need 
    … …  
    12981289  siz3 = SIZE(var,3) 
    12991290  var_sz = siz1*siz2*siz3 
    1300   CALL rest_alloc (1,var_sz,check,'restget_r3d') 
     1291  CALL rest_alloc (1,var_sz,l_dbg,'restget_r3d') 
    13011292!- 
    13021293! 2.0 Here we check if the sizes specified agree 
    … …  
    13751366  REAL :: var(:) 
    13761367!- 
    1377 ! LOCAL 
    1378 !- 
    1379   INTEGER :: vid,vnb,ncfid 
    1380   INTEGER :: iret,index,it,ndim,ia 
     1368  INTEGER :: vid,vnb,ncfid,iret,index,it,ndim,ia 
    13811369  CHARACTER(LEN=70) str,str2 
    13821370  CHARACTER(LEN=80) attname 
    13831371  INTEGER,DIMENSION(4) :: corner,edge 
    13841372!--------------------------------------------------------------------- 
    1385 !- 
    13861373  ncfid = netcdf_id(fid,1) 
    13871374!- 
    … …  
    14431430      IF (t_index(fid,it) == itau)  index = it 
    14441431    ENDDO 
    1445 !--- 
    14461432    IF (index < 0) THEN 
    14471433      str = 'The time step requested for variable '//TRIM(vname_q) 
    … …  
    15461532  INTEGER :: nbindex,ijndex(nbindex) 
    15471533!- 
    1548 ! LOCAL 
    1549 !- 
    15501534  INTEGER :: req_sz,siz1 
    15511535  REAL :: scal 
    15521536  CHARACTER(LEN=7) :: topp 
    1553   LOGICAL :: check = .FALSE. 
    1554 !--------------------------------------------------------------------- 
     1537  LOGICAL :: l_dbg 
     1538!--------------------------------------------------------------------- 
     1539  CALL ipsldbg (old_status=l_dbg) 
    15551540!- 
    15561541! 0.0 What size should be the data in the file 
    … …  
    15711556!- 
    15721557  siz1 = SIZE(var) 
    1573   CALL rest_alloc (1,siz1,check,'restput_opp_r1d') 
    1574   CALL rest_alloc (2,req_sz,check,'restput_opp_r1d') 
     1558  CALL rest_alloc (1,siz1,l_dbg,'restput_opp_r1d') 
     1559  CALL rest_alloc (2,req_sz,l_dbg,'restput_opp_r1d') 
    15751560!- 
    15761561! 2.0 We do the operation needed. 
    … …  
    16231608  INTEGER :: nbindex,ijndex(nbindex) 
    16241609!- 
    1625 ! LOCAL 
    1626 !- 
    16271610  INTEGER :: jj,req_sz,ist,siz1 
    16281611  REAL :: scal 
    16291612  CHARACTER(LEN=7) :: topp 
    1630   LOGICAL :: check = .FALSE. 
    1631 !--------------------------------------------------------------------- 
     1613  LOGICAL :: l_dbg 
     1614!--------------------------------------------------------------------- 
     1615  CALL ipsldbg (old_status=l_dbg) 
    16321616!- 
    16331617! 0.0 What size should be the data in the file 
    … …  
    16531637!- 
    16541638  siz1 = SIZE(var,1) 
    1655   CALL rest_alloc (1,siz1,check,'restput_opp_r2d') 
    1656   CALL rest_alloc (2,req_sz*jjm,check,'restput_opp_r2d') 
     1639  CALL rest_alloc (1,siz1,l_dbg,'restput_opp_r2d') 
     1640  CALL rest_alloc (2,req_sz*jjm,l_dbg,'restput_opp_r2d') 
    16571641!- 
    16581642! 2.0 We do the operation needed. 
    … …  
    16941678  REAL :: var(:) 
    16951679!- 
    1696 ! LOCAL 
    1697 !- 
    16981680  INTEGER :: ji,jl,req_sz,var_sz,siz1 
    16991681  CHARACTER(LEN=70) :: str,str2 
    1700   LOGICAL :: check = .FALSE. 
    1701 !--------------------------------------------------------------------- 
     1682  LOGICAL :: l_dbg 
     1683!--------------------------------------------------------------------- 
     1684  CALL ipsldbg (old_status=l_dbg) 
    17021685!- 
    17031686! 1.0 Allocate the temporary buffer we need 
    … …  
    17061689  siz1 = SIZE(var) 
    17071690  var_sz = siz1 
    1708   CALL rest_alloc (1,var_sz,check,'restput_r1d') 
     1691  CALL rest_alloc (1,var_sz,l_dbg,'restput_r1d') 
    17091692!- 
    17101693! 2.0 Here we could check if the sizes specified agree 
    … …  
    17531736  REAL :: var(:,:) 
    17541737!- 
    1755 ! LOCAL 
    1756 !- 
    17571738  INTEGER :: ji,jj,jl,req_sz,var_sz,siz1,siz2 
    17581739  CHARACTER(LEN=70) :: str,str2 
    1759   LOGICAL :: check = .FALSE. 
    1760 !--------------------------------------------------------------------- 
     1740  LOGICAL :: l_dbg 
     1741!--------------------------------------------------------------------- 
     1742  CALL ipsldbg (old_status=l_dbg) 
    17611743!- 
    17621744! 1.0 Allocate the temporary buffer we need 
    … …  
    17661748  siz2 = SIZE(var,2) 
    17671749  var_sz = siz1*siz2 
    1768   CALL rest_alloc (1,var_sz,check,'restput_r2d') 
     1750  CALL rest_alloc (1,var_sz,l_dbg,'restput_r2d') 
    17691751!- 
    17701752! 2.0 Here we could check if the sizes specified agree 
    … …  
    18141796  REAL :: var(:,:,:) 
    18151797!- 
    1816 ! LOCAL 
    1817 !- 
    18181798  INTEGER :: ji,jj,jk,jl,req_sz,var_sz,siz1,siz2,siz3 
    18191799  CHARACTER(LEN=70) :: str,str2 
    1820   LOGICAL :: check = .FALSE. 
    1821 !--------------------------------------------------------------------- 
     1800  LOGICAL :: l_dbg 
     1801!--------------------------------------------------------------------- 
     1802  CALL ipsldbg (old_status=l_dbg) 
    18221803!- 
    18231804! 1.0 Allocate the temporary buffer we need 
    … …  
    18281809  siz3 = SIZE(var,3) 
    18291810  var_sz = siz1*siz2*siz3 
    1830   CALL rest_alloc (1,var_sz,check,'restput_r3d') 
     1811  CALL rest_alloc (1,var_sz,l_dbg,'restput_r3d') 
    18311812!- 
    18321813! 2.0 Here we could check if the sizes specified agree 
    … …  
    18991880  REAL :: var(:) 
    19001881!- 
    1901 ! LOCAL 
    1902 !- 
    19031882  INTEGER :: iret,vid,ncid,iv,vnb 
    19041883  INTEGER :: ierr 
    … …  
    19061885  INTEGER :: ndims 
    19071886  INTEGER,DIMENSION(4) :: corner,edge 
    1908 !- 
    1909   LOGICAL :: check = .FALSE. 
    1910 !--------------------------------------------------------------------- 
     1887  LOGICAL :: l_dbg 
     1888!--------------------------------------------------------------------- 
     1889  CALL ipsldbg (old_status=l_dbg) 
    19111890!- 
    19121891! 0.0 Get some variables 
    … …  
    19211900! 1.0 Check if the variable is already present 
    19221901!- 
    1923   IF (check) WRITE(*,*) 'RESTPUT 1.0 : ',TRIM(vname_q) 
     1902  IF (l_dbg) WRITE(*,*) 'RESTPUT 1.0 : ',TRIM(vname_q) 
    19241903!- 
    19251904  CALL find_str (varname_out(fid,1:nbvar_out(fid)),vname_q,vnb) 
    19261905!- 
    1927   IF (check) THEN 
     1906  IF (l_dbg) THEN 
    19281907    WRITE(*,*) 'RESTPUT 1.1 : ',varname_out(fid,1:nbvar_out(fid)),vnb 
    19291908  ENDIF 
    … …  
    19381917  vid = varid_out(fid,vnb) 
    19391918!- 
    1940   IF (check) WRITE(*,*) 'RESTPUT 2.0 : ',vnb,vid 
     1919  IF (l_dbg) WRITE(*,*) 'RESTPUT 2.0 : ',vnb,vid 
    19411920!- 
    19421921! 2.1 Is this file already in write mode ? 
    … …  
    19511930!     If not then check that all variables of previous time is OK. 
    19521931!- 
    1953   IF (check) WRITE(*,*) 'RESTPUT 3.0 : ',itau,itau_out(fid) 
     1932  IF (l_dbg) WRITE(*,*) 'RESTPUT 3.0 : ',itau,itau_out(fid) 
    19541933!- 
    19551934  IF (itau /= itau_out(fid)) THEN 
    … …  
    19891968!-- 3.1 Here we add the values to the time axes 
    19901969!--- 
    1991     IF (check) THEN 
     1970    IF (l_dbg) THEN 
    19921971      WRITE(*,*) 'RESTPUT 3.1 : ',itau,secsince,corner(1),edge(1) 
    19931972    ENDIF 
    … …  
    20522031  LOGICAL :: write_att 
    20532032!- 
    2054 ! Local 
    2055 !- 
    20562033  INTEGER :: dims(4),ic,xloc,ndim,ncfid 
    20572034  INTEGER :: iret,ax_id 
    20582035  CHARACTER(LEN=3) :: str 
    2059 !- 
    2060   LOGICAL :: check = .FALSE. 
    2061 !--------------------------------------------------------------------- 
     2036  LOGICAL :: l_dbg 
     2037!--------------------------------------------------------------------- 
     2038  CALL ipsldbg (old_status=l_dbg) 
     2039!- 
    20622040  ncfid = netcdf_id(fid,2) 
    20632041  IF (nbvar_out(fid) >= max_var) THEN 
    … …  
    20772055! 1.0 Do we have all dimensions and can we go ahead 
    20782056!- 
    2079   IF (check) THEN 
     2057  IF (l_dbg) THEN 
    20802058    WRITE(*,*) 'restdefv 1.0 :',TRIM(varname),nbvar_out(fid) 
    20812059  ENDIF 
    … …  
    21532131! 2.0  Declare the variable 
    21542132!- 
    2155   IF (check) THEN 
     2133  IF (l_dbg) THEN 
    21562134    WRITE(*,*) 'restdefv 2.0 :',ndim,' :: ',dims(1:ndim),tdimid_out(fid) 
    21572135  ENDIF 
    … …  
    21882166  ENDIF 
    21892167!- 
    2190   IF (check) THEN 
     2168  IF (l_dbg) THEN 
    21912169    WRITE(*,*) & 
    21922170 &    'restdefv 3.0 : LIST OF VARS ',varname_out(fid,1:nbvar_out(fid)) 
    … …  
    23592337!- 
    23602338  CHARACTER(LEN=*) :: attname,value 
    2361 !- 
    2362 ! LOCAL 
    23632339!- 
    23642340  CHARACTER(LEN=LEN_TRIM(attname)) :: tmp_str 
    … …  
    23932369  INTEGER,DIMENSION(varnbdim_max),INTENT(OUT) :: vardims 
    23942370!- 
    2395 ! LOCAL 
    2396 !- 
    23972371  INTEGER :: vnb 
    23982372!--------------------------------------------------------------------- 
    … …  
    24932467  INTEGER,INTENT(in),OPTIONAL :: fid 
    24942468!- 
    2495 !- LOCAL 
    2496 !- 
    24972469  INTEGER :: iret,ifnc 
    24982470  CHARACTER(LEN=6) :: n_e 
    24992471  CHARACTER(LEN=3) :: n_f 
    2500   LOGICAL :: check = .FALSE. 
    2501 !--------------------------------------------------------------------- 
     2472  LOGICAL :: l_dbg 
     2473!--------------------------------------------------------------------- 
     2474  CALL ipsldbg (old_status=l_dbg) 
     2475!- 
    25022476  IF (PRESENT(fid)) THEN 
    25032477!--- 
    2504     IF (check) THEN 
     2478    IF (l_dbg) THEN 
    25052479      WRITE(*,*) & 
    25062480        'restclo : Closing specified restart file number :', & 
    … …  
    25352509  ELSE 
    25362510!--- 
    2537     IF (check) WRITE(*,*) 'restclo : Closing all files' 
     2511    IF (l_dbg) WRITE(*,*) 'restclo : Closing all files' 
    25382512!--- 
    25392513    DO ifnc=1,nb_fi 
Note: See TracChangeset for help on using the changeset viewer.