Changeset 1524 for IOIPSL


Ignore:
Timestamp:
08/09/11 10:13:26 (13 years ago)
Author:
mmaipsl
Message:

Add lot of debug prints. Keep name of each restart files.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • IOIPSL/trunk/src/restcom.f90

    r1378 r1524  
    4949  INTEGER,SAVE :: nb_fi = 0 
    5050  INTEGER,DIMENSION(max_file,2),SAVE :: netcdf_id = -1 
     51  CHARACTER(LEN=120),DIMENSION(max_file,2),SAVE :: netcdf_name='NONE' 
    5152!- 
    5253! Description of the content of the 'in' files and the 'out' files. 
     
    268269    CALL restopenin (nb_fi,fname,l_rw,iim,jjm,lon,lat,llm,lev,ncfid) 
    269270    netcdf_id(nb_fi,1) = ncfid 
     271    netcdf_name(nb_fi,1) = TRIM(fnamein) 
    270272!--- 
    271273!-- 1.3 Extract the time information 
     
    324326      (nb_fi,fname,iim,jjm,lon,lat,llm,lev,dt,date0,ncfid,domain_id) 
    325327    netcdf_id(nb_fi,2) = ncfid 
     328    netcdf_name(nb_fi,2) = TRIM(fnameout) 
    326329  ELSE IF (l_fi.AND.l_fo) THEN 
    327330    netcdf_id(nb_fi,2) = netcdf_id(nb_fi,1) 
     331    netcdf_name(nb_fi,2) = netcdf_name(nb_fi,1) 
    328332    varname_out(nb_fi,:) = varname_in(nb_fi,:) 
    329333    nbvar_out(nb_fi) = nbvar_in(nb_fi) 
     
    13721376  CHARACTER(LEN=80) attname 
    13731377  INTEGER,DIMENSION(4) :: corner,edge 
    1374 !--------------------------------------------------------------------- 
     1378  LOGICAL :: l_dbg 
     1379!--------------------------------------------------------------------- 
     1380  CALL ipsldbg (old_status=l_dbg) 
     1381!--------------------------------------------------------------------- 
     1382  IF (l_dbg) WRITE(ipslout,*) 'RESTGET 0.0 : ',netcdf_name(fid,2),vname_q,iim,jjm,llm,itau,def_beha 
     1383!- 
    13751384  ncfid = netcdf_id(fid,1) 
    13761385!- 
     
    13791388! 1.0 If the variable is not present then ERROR or filled up 
    13801389!     by default values if allowed 
     1390!- 
     1391  IF (l_dbg) WRITE(ipslout,*) 'RESTGET 1.0 : ',vnb 
    13811392!- 
    13821393  IF (vnb < 0) THEN 
     
    14021413!----- 
    14031414      CALL restdefv (fid,vname_q,iim,jjm,llm,.TRUE.) 
     1415      IF (l_dbg) WRITE(ipslout,*) 'RESTGET 1.1 : ',vnb 
    14041416!----- 
    14051417    ELSE 
     
    14161428!--- 
    14171429    vid = varid_in(fid,vnb) 
     1430    IF (l_dbg) WRITE(ipslout,*) 'RESTGET 2.0 : ',vid 
    14181431!--- 
    14191432    nbvar_read(fid) = nbvar_read(fid)+1 
     
    14371450 &      str,'is not available in the current file',' ') 
    14381451    ENDIF 
     1452    IF (l_dbg) WRITE(ipslout,*) 'RESTGET 3.0 : ',index 
    14391453!--- 
    14401454!-- 4.0 Read the data. Note that the variables in the restart files 
     
    14881502    iret = NF90_GET_VAR(ncfid,vid,var, & 
    14891503 &                      start=corner(1:ndim),count=edge(1:ndim)) 
     1504    IF (l_dbg) WRITE(ipslout,*) 'RESTGET 4.0 : ',iret 
    14901505!--- 
    14911506!-- 5.0 The variable we have just read is created 
     
    18991914  ENDIF 
    19001915  CALL ioget_calendar (one_year,one_day) 
     1916!- 
     1917! 0.0 show arguments 
     1918  IF (l_dbg) WRITE(ipslout,*) 'RESTPUT 0.0 : ',netcdf_name(fid,2),vname_q,iim,jjm,llm,itau 
    19011919!- 
    19021920! 1.0 Check if the variable is already present 
     
    20532071  IF (itau_out(fid) >= 0) THEN 
    20542072    iret = NF90_REDEF(ncfid) 
     2073    IF (l_dbg) THEN 
     2074       WRITE(ipslout,*) 'restdefv 0.0 : REDEF',itau_out(fid) 
     2075    ENDIF 
    20552076  ENDIF 
    20562077!- 
     
    24812502      WRITE(ipslout,*) & 
    24822503        'restclo : Closing specified restart file number :', & 
    2483         fid,netcdf_id(fid,1:2) 
     2504        fid,netcdf_id(fid,1:2),netcdf_name(fid,1:2) 
    24842505    ENDIF 
    24852506!--- 
     
    24902511        WRITE (n_f,'(I3)') netcdf_id(fid,1) 
    24912512        CALL ipslerr (2,'restclo', & 
    2492           "Error "//n_e//" in closing file : "//n_f,'',' ') 
     2513          "Error "//n_e//" in closing file : "//n_f,netcdf_name(fid,1),' ') 
    24932514      ENDIF 
    24942515      IF (netcdf_id(fid,1) == netcdf_id(fid,2)) THEN 
    24952516        netcdf_id(fid,2) = -1 
     2517        netcdf_name(fid,2) = 'NONE' 
    24962518      ENDIF 
    24972519      netcdf_id(fid,1) = -1 
     2520      netcdf_name(fid,1) = 'NONE' 
    24982521    ENDIF 
    24992522!--- 
     
    25042527        WRITE (n_f,'(I3)') netcdf_id(fid,2) 
    25052528        CALL ipslerr (2,'restclo', & 
    2506           "Error "//n_e//" in closing file : "//n_f,'',' ') 
     2529          "Error "//n_e//" in closing file : "//n_f,netcdf_name(fid,2),' ') 
    25072530      ENDIF 
    25082531      netcdf_id(fid,2) = -1 
     2532      netcdf_name(fid,2) = 'NONE' 
    25092533    ENDIF 
    25102534!--- 
     
    25202544          WRITE (n_f,'(I3)') netcdf_id(ifnc,1) 
    25212545          CALL ipslerr (2,'restclo', & 
    2522             "Error "//n_e//" in closing file : "//n_f,'',' ') 
     2546            "Error "//n_e//" in closing file : "//n_f,netcdf_name(ifnc,1),' ') 
     2547        ENDIF 
     2548        IF (l_dbg) THEN 
     2549           WRITE(ipslout,*) & 
     2550                'restclo : Closing specified restart file number :', & 
     2551                ifnc,netcdf_id(ifnc,1:2),netcdf_name(ifnc,1:2) 
    25232552        ENDIF 
    25242553        IF (netcdf_id(ifnc,1) == netcdf_id(ifnc,2)) THEN 
    25252554          netcdf_id(ifnc,2) = -1 
     2555          netcdf_name(ifnc,2) = 'NONE' 
    25262556        ENDIF 
    25272557        netcdf_id(ifnc,1) = -1 
     2558        netcdf_name(ifnc,1) = 'NONE' 
    25282559      ENDIF 
    25292560!----- 
     
    25342565          WRITE (n_f,'(I3)') netcdf_id(ifnc,2) 
    25352566          CALL ipslerr (2,'restclo', & 
    2536             "Error "//n_e//" in closing file : "//n_f,'',' ') 
     2567            "Error "//n_e//" in closing file : "//n_f,netcdf_name(ifnc,2),' ') 
     2568        END IF 
     2569        IF (l_dbg) THEN 
     2570           WRITE(ipslout,*) & 
     2571                'restclo : Closing specified restart file number :', & 
     2572                ifnc,netcdf_id(ifnc,1:2),netcdf_name(ifnc,1:2) 
    25372573        END IF 
    25382574        netcdf_id(ifnc,2) = -1 
     2575        netcdf_name(ifnc,2) = 'NONE' 
    25392576      ENDIF 
    25402577    ENDDO 
Note: See TracChangeset for help on using the changeset viewer.