Ignore:
Timestamp:
04/20/11 12:08:00 (11 years ago)
Author:
mmaipsl
Message:

Enhancement : use ipslout number from errioipsl to redirect all prints of IOIPSL
in the local process when use with parallelization.
This variable ipslout can be modified with ipslnlf function of errioipsl module.

File:
1 edited

Legend:

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

    r430 r1378  
    88USE netcdf 
    99!- 
    10 USE errioipsl, ONLY : ipslerr,ipsldbg 
     10USE errioipsl, ONLY : ipslerr,ipsldbg, ipslout 
    1111USE stringop 
    1212USE calendar 
     
    230230!- 
    231231  IF (l_dbg) THEN 
    232     WRITE(*,*) 'restini 0.0 : ',TRIM(fnamein),' , ',TRIM(fnameout) 
     232    WRITE(ipslout,*) 'restini 0.0 : ',TRIM(fnamein),' , ',TRIM(fnameout) 
    233233  ENDIF 
    234234!- 
     
    254254!- 
    255255  IF (l_dbg) THEN 
    256     WRITE(*,*) 'restini 0.1 l_fi, l_fo, l_rw : ',l_fi,l_fo,l_rw 
     256    WRITE(ipslout,*) 'restini 0.1 l_fi, l_fo, l_rw : ',l_fi,l_fo,l_rw 
    257257  ENDIF 
    258258!- 
     
    261261  IF (l_fi) THEN 
    262262!--- 
    263     IF (l_dbg) WRITE(*,*) 'restini 1.0 : Open input file' 
     263    IF (l_dbg) WRITE(ipslout,*) 'restini 1.0 : Open input file' 
    264264!-- Add DOMAIN number and ".nc" suffix in file names if needed 
    265265    fname = fnamein 
     
    284284!-- 2.0 The case of a missing restart file is dealt with 
    285285!--- 
    286     IF (l_dbg) WRITE(*,*) 'restini 2.0' 
     286    IF (l_dbg) WRITE(ipslout,*) 'restini 2.0' 
    287287!--- 
    288288    IF (     (ALL(MINLOC(lon(:iim,:jjm)) == MAXLOC(lon(:iim,:jjm)))) & 
     
    340340!- 
    341341  IF (l_dbg) THEN 
    342     WRITE(*,*) 'restini 2.3 : Configure calendar if needed : ', & 
     342    WRITE(ipslout,*) 'restini 2.3 : Configure calendar if needed : ', & 
    343343                calend_str 
    344344  ENDIF 
     
    347347    CALL ioconf_calendar (calend_str) 
    348348    IF (l_dbg) THEN 
    349       WRITE(*,*) 'restini 2.3b : new calendar : ',calend_str 
     349      WRITE(ipslout,*) 'restini 2.3b : new calendar : ',calend_str 
    350350    ENDIF 
    351351  ENDIF 
     
    359359  fid = nb_fi 
    360360  IF (l_dbg) THEN 
    361     WRITE(*,*) 'SIZE of t_index :',SIZE(t_index), & 
     361    WRITE(ipslout,*) 'SIZE of t_index :',SIZE(t_index), & 
    362362               SIZE(t_index,dim=1),SIZE(t_index,dim=2) 
    363     WRITE(*,*) 't_index = ',t_index(fid,:) 
     363    WRITE(ipslout,*) 't_index = ',t_index(fid,:) 
    364364  ENDIF 
    365365  itau = t_index(fid,1) 
    366366!- 
    367   IF (l_dbg) WRITE(*,*) 'restini END' 
     367  IF (l_dbg) WRITE(ipslout,*) 'restini END' 
    368368!--------------------- 
    369369END SUBROUTINE restini 
     
    502502! 2.0 Get the list of variables 
    503503!- 
    504   IF (l_dbg) WRITE(*,*) 'restopenin 1.2' 
     504  IF (l_dbg) WRITE(ipslout,*) 'restopenin 1.2' 
    505505!- 
    506506  lat_vid = -1 
     
    663663      CALL ioconf_calendar (calendar) 
    664664      IF (l_dbg) THEN 
    665         WRITE(*,*) 'restsett : calendar of the restart ',calendar 
     665        WRITE(ipslout,*) 'restsett : calendar of the restart ',calendar 
    666666      ENDIF 
    667667    ENDIF 
     
    669669  CALL ioget_calendar (one_year,one_day) 
    670670  IF (l_dbg) THEN 
    671     WRITE(*,*) 'one_year,one_day = ',one_year,one_day 
     671    WRITE(ipslout,*) 'one_year,one_day = ',one_year,one_day 
    672672  ENDIF 
    673673!- 
     
    681681      t_index(nb_fi,:) = itau 
    682682      IF (l_dbg) THEN 
    683         WRITE(*,*) "nb_fi,t_index",nb_fi,t_index(nb_fi,:) 
     683        WRITE(ipslout,*) "nb_fi,t_index",nb_fi,t_index(nb_fi,:) 
    684684      ENDIF 
    685685      CALL ju2ymds (date0,year0,month0,day0,sec0) 
     
    691691      strc=':' 
    692692      IF (l_dbg) THEN 
    693         WRITE(*,*) date0 
     693        WRITE(ipslout,*) date0 
    694694        WRITE (UNIT=itau_orig,FMT='(I4.4,5(A,I2.2))') & 
    695695 &       year0,'-',month0,'-',day0,' ',hours0,':',minutes0,':',seci 
    696         WRITE(*,*) "itau_orig : ",itau_orig 
     696        WRITE(ipslout,*) "itau_orig : ",itau_orig 
    697697      ENDIF 
    698698    ELSE 
    699699      iret = NF90_GET_VAR(ncfid,tind_varid_in(nb_fi),t_index(nb_fi,:)) 
    700700      IF (l_dbg) THEN 
    701         WRITE(*,*) "restsett, time axis : ",t_index(nb_fi,:) 
     701        WRITE(ipslout,*) "restsett, time axis : ",t_index(nb_fi,:) 
    702702      ENDIF 
    703703      iret = NF90_GET_ATT(ncfid,tind_varid_in(nb_fi),'units',itau_orig) 
     
    727727    iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'calendar',tmp_cal) 
    728728    IF (l_dbg) THEN 
    729       WRITE(*,*) 'restsett : tmp_calendar of the restart ',tmp_cal 
     729      WRITE(ipslout,*) 'restsett : tmp_calendar of the restart ',tmp_cal 
    730730    ENDIF 
    731731!--- 
     
    744744!-- to get ride of the intial date. 
    745745!--- 
    746     IF (l_dbg) WRITE(*,*) 'tax_orig : ',TRIM(tax_orig) 
     746    IF (l_dbg) WRITE(ipslout,*) 'tax_orig : ',TRIM(tax_orig) 
    747747    READ (UNIT=tax_orig,FMT='(I4.4,5(a,I2.2))') & 
    748748      year0,strc,month0,strc,day0,strc, & 
     
    831831  CALL ipsldbg (old_status=l_dbg) 
    832832!- 
    833   IF (l_dbg) WRITE(*,*) "restopenout 0.0 ",TRIM(fname) 
     833  IF (l_dbg) WRITE(ipslout,*) "restopenout 0.0 ",TRIM(fname) 
    834834!- 
    835835!  If we use the same file for input and output 
     
    863863! 1.0 Longitude 
    864864!- 
    865   IF (l_dbg) WRITE(*,*) "restopenout 1.0" 
     865  IF (l_dbg) WRITE(ipslout,*) "restopenout 1.0" 
    866866!- 
    867867  iret = NF90_DEF_VAR(ncfid,"nav_lon",NF90_FLOAT,(/x_id,y_id/),nlonid) 
     
    873873! 2.0 Latitude 
    874874!- 
    875   IF (l_dbg) WRITE(*,*) "restopenout 2.0" 
     875  IF (l_dbg) WRITE(ipslout,*) "restopenout 2.0" 
    876876!- 
    877877  iret = NF90_DEF_VAR(ncfid,"nav_lat",NF90_FLOAT,(/x_id,y_id/),nlatid) 
     
    883883! 3.0 Levels 
    884884!- 
    885   IF (l_dbg) WRITE(*,*) "restopenout 3.0" 
     885  IF (l_dbg) WRITE(ipslout,*) "restopenout 3.0" 
    886886!- 
    887887  iret = NF90_DEF_VAR(ncfid,"nav_lev",NF90_FLOAT,z_id,nlevid) 
     
    895895! 4.0 Time axis, this is the seconds since axis 
    896896!- 
    897   IF (l_dbg) WRITE(*,*) "restopenout 4.0" 
     897  IF (l_dbg) WRITE(ipslout,*) "restopenout 4.0" 
    898898!- 
    899899  iret = NF90_DEF_VAR(ncfid,"time",NF90_FLOAT, & 
     
    923923! 5.0 Time axis, this is the time steps since axis 
    924924!- 
    925   IF (l_dbg) WRITE(*,*) "restopenout 5.0" 
     925  IF (l_dbg) WRITE(ipslout,*) "restopenout 5.0" 
    926926!- 
    927927  iret = NF90_DEF_VAR(ncfid,"time_steps",NF90_INT, & 
     
    984984  iret = NF90_REDEF(ncfid) 
    985985!- 
    986   IF (l_dbg) WRITE(*,*) "restopenout END" 
     986  IF (l_dbg) WRITE(ipslout,*) "restopenout END" 
    987987!------------------------- 
    988988END SUBROUTINE restopenout 
     
    19021902! 1.0 Check if the variable is already present 
    19031903!- 
    1904   IF (l_dbg) WRITE(*,*) 'RESTPUT 1.0 : ',TRIM(vname_q) 
     1904  IF (l_dbg) WRITE(ipslout,*) 'RESTPUT 1.0 : ',TRIM(vname_q) 
    19051905!- 
    19061906  CALL find_str (varname_out(fid,1:nbvar_out(fid)),vname_q,vnb) 
    19071907!- 
    19081908  IF (l_dbg) THEN 
    1909     WRITE(*,*) 'RESTPUT 1.1 : ',varname_out(fid,1:nbvar_out(fid)),vnb 
     1909    WRITE(ipslout,*) 'RESTPUT 1.1 : ',varname_out(fid,1:nbvar_out(fid)),vnb 
    19101910  ENDIF 
    19111911!- 
     
    19191919  vid = varid_out(fid,vnb) 
    19201920!- 
    1921   IF (l_dbg) WRITE(*,*) 'RESTPUT 2.0 : ',vnb,vid 
     1921  IF (l_dbg) WRITE(ipslout,*) 'RESTPUT 2.0 : ',vnb,vid 
    19221922!- 
    19231923! 2.1 Is this file already in write mode ? 
     
    19321932!     If not then check that all variables of previous time is OK. 
    19331933!- 
    1934   IF (l_dbg) WRITE(*,*) 'RESTPUT 3.0 : ',itau,itau_out(fid) 
     1934  IF (l_dbg) WRITE(ipslout,*) 'RESTPUT 3.0 : ',itau,itau_out(fid) 
    19351935!- 
    19361936  IF (itau /= itau_out(fid)) THEN 
     
    19421942    IF (tstp_out(fid) == 0) THEN 
    19431943      IF (nbvar_out(fid) < nbvar_read(fid)) THEN 
    1944         WRITE(*,*) "ERROR :",tstp_out(fid), & 
     1944        WRITE(ipslout,*) "ERROR :",tstp_out(fid), & 
    19451945                   nbvar_out(fid),nbvar_read(fid) 
    19461946        CALL ipslerr (1,'restput', & 
     
    19551955      ENDDO 
    19561956      IF (ierr > 0) THEN 
    1957         WRITE(*,*) "ERROR :",nbvar_out(fid) 
     1957        WRITE(ipslout,*) "ERROR :",nbvar_out(fid) 
    19581958        CALL ipslerr (1,'restput', & 
    19591959 &        'There are fewer variables in the output file for this', & 
     
    19711971!--- 
    19721972    IF (l_dbg) THEN 
    1973       WRITE(*,*) 'RESTPUT 3.1 : ',itau,secsince,corner(1),edge(1) 
     1973      WRITE(ipslout,*) 'RESTPUT 3.1 : ',itau,secsince,corner(1),edge(1) 
    19741974    ENDIF 
    19751975!--- 
     
    20582058!- 
    20592059  IF (l_dbg) THEN 
    2060     WRITE(*,*) 'restdefv 1.0 :',TRIM(varname),nbvar_out(fid) 
     2060    WRITE(ipslout,*) 'restdefv 1.0 :',TRIM(varname),nbvar_out(fid) 
    20612061  ENDIF 
    20622062!- 
     
    21342134!- 
    21352135  IF (l_dbg) THEN 
    2136     WRITE(*,*) 'restdefv 2.0 :',ndim,' :: ',dims(1:ndim),tdimid_out(fid) 
     2136    WRITE(ipslout,*) 'restdefv 2.0 :',ndim,' :: ',dims(1:ndim),tdimid_out(fid) 
    21372137  ENDIF 
    21382138!- 
     
    21692169!- 
    21702170  IF (l_dbg) THEN 
    2171     WRITE(*,*) & 
     2171    WRITE(ipslout,*) & 
    21722172 &    'restdefv 3.0 : LIST OF VARS ',varname_out(fid,1:nbvar_out(fid)) 
    21732173  ENDIF 
     
    21932193  IF (.NOT.ALLOCATED(t_index) .AND. .NOT.ALLOCATED(t_julian)) THEN 
    21942194    IF (l_msg) THEN 
    2195       WRITE(*,*) TRIM(c_p)//' : Allocate times axes at :', & 
     2195      WRITE(ipslout,*) TRIM(c_p)//' : Allocate times axes at :', & 
    21962196 &               max_file,tax_size_in(nb_fi) 
    21972197    ENDIF 
     
    21992199    ALLOCATE(t_index(max_file,tax_size_in(nb_fi)),STAT=i_err) 
    22002200    IF (i_err/=0) THEN 
    2201       WRITE(*,*) "ERROR IN ALLOCATION of t_index : ",i_err 
     2201      WRITE(ipslout,*) "ERROR IN ALLOCATION of t_index : ",i_err 
    22022202      CALL ipslerr (3,TRIM(c_p), & 
    22032203 &      'Problem in allocation of t_index','', & 
     
    22082208    ALLOCATE(t_julian(max_file,tax_size_in(nb_fi)),STAT=i_err) 
    22092209    IF (i_err/=0) THEN 
    2210       WRITE(*,*) "ERROR IN ALLOCATION of t_julian : ",i_err 
     2210      WRITE(ipslout,*) "ERROR IN ALLOCATION of t_julian : ",i_err 
    22112211      CALL ipslerr (3,TRIM(c_p), & 
    22122212 &      'Problem in allocation of max_file,tax_size_in','', & 
     
    22172217 &         .OR.(SIZE(t_julian,DIM=2) < tax_size_in(nb_fi)) ) THEN 
    22182218    IF (l_msg) THEN 
    2219       WRITE(*,*) TRIM(c_p)//' : Reallocate times axes at :', & 
     2219      WRITE(ipslout,*) TRIM(c_p)//' : Reallocate times axes at :', & 
    22202220 &               max_file,tax_size_in(nb_fi) 
    22212221    ENDIF 
     
    22232223    ALLOCATE (tmp_index(max_file,tax_size_in(nb_fi)),STAT=i_err) 
    22242224    IF (i_err/=0) THEN 
    2225       WRITE(*,*) "ERROR IN ALLOCATION of tmp_index : ",i_err 
     2225      WRITE(ipslout,*) "ERROR IN ALLOCATION of tmp_index : ",i_err 
    22262226      CALL ipslerr (3,TRIM(c_p), & 
    22272227 &      'Problem in allocation of tmp_index','', & 
     
    22332233    ALLOCATE (t_index(max_file,tax_size_in(nb_fi)),STAT=i_err) 
    22342234    IF (i_err/=0) THEN 
    2235       WRITE(*,*) "ERROR IN ALLOCATION of t_index : ",i_err 
     2235      WRITE(ipslout,*) "ERROR IN ALLOCATION of t_index : ",i_err 
    22362236      CALL ipslerr (3,TRIM(c_p), & 
    22372237 &     'Problem in reallocation of t_index','', & 
     
    22422242    ALLOCATE (tmp_julian(max_file,tax_size_in(nb_fi)),STAT=i_err) 
    22432243    IF (i_err/=0) THEN 
    2244       WRITE(*,*) "ERROR IN ALLOCATION of tmp_julian : ",i_err 
     2244      WRITE(ipslout,*) "ERROR IN ALLOCATION of tmp_julian : ",i_err 
    22452245      CALL ipslerr (3,TRIM(c_p), & 
    22462246 &     'Problem in allocation of tmp_julian','', & 
     
    22522252    ALLOCATE (t_julian(max_file,tax_size_in(nb_fi)),STAT=i_err) 
    22532253    IF (i_err/=0) THEN 
    2254       WRITE(*,*) "ERROR IN ALLOCATION of t_julian : ",i_err 
     2254      WRITE(ipslout,*) "ERROR IN ALLOCATION of t_julian : ",i_err 
    22552255      CALL ipslerr (3,TRIM(c_p), & 
    22562256 &      'Problem in reallocation of t_julian','', & 
     
    23082308      IF (    (l_alloc1.AND.ALLOCATED(buff_tmp1)) & 
    23092309 &        .OR.(l_alloc2.AND.ALLOCATED(buff_tmp2)) ) THEN 
    2310         WRITE(*,*) TRIM(c_p)//" : re_allocate "//TRIM(cbn)//"=",i_qsz 
     2310        WRITE(ipslout,*) TRIM(c_p)//" : re_allocate "//TRIM(cbn)//"=",i_qsz 
    23112311      ELSE 
    2312         WRITE(*,*) TRIM(c_p)//" : allocate "//TRIM(cbn)//"=",i_qsz 
     2312        WRITE(ipslout,*) TRIM(c_p)//" : allocate "//TRIM(cbn)//"=",i_qsz 
    23132313      ENDIF 
    23142314    ENDIF 
     
    24792479!--- 
    24802480    IF (l_dbg) THEN 
    2481       WRITE(*,*) & 
     2481      WRITE(ipslout,*) & 
    24822482        'restclo : Closing specified restart file number :', & 
    24832483        fid,netcdf_id(fid,1:2) 
     
    25112511  ELSE 
    25122512!--- 
    2513     IF (l_dbg) WRITE(*,*) 'restclo : Closing all files' 
     2513    IF (l_dbg) WRITE(ipslout,*) 'restclo : Closing all files' 
    25142514!--- 
    25152515    DO ifnc=1,nb_fi 
Note: See TracChangeset for help on using the changeset viewer.