Changeset 1378 for IOIPSL/trunk/src/histcom.f90

Timestamp:

04/20/11 12:08:00 (13 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:

• IOIPSL/trunk/src/histcom.f90 (modified) (54 diffs)

IOIPSL/trunk/src/histcom.f90

@@ -12 +12 @@
   USE fliocom,  ONLY : flio_dom_file,flio_dom_att
   USE calendar
-  USE errioipsl, ONLY : ipslerr,ipsldbg
+  USE errioipsl, ONLY : ipslerr,ipsldbg,ipslout
 !-
   IMPLICIT NONE
@@ -340 +340 @@
   ENDIF
 !-
-  IF (l_dbg) WRITE(*,*) c_nam//" 0.0"
+  IF (l_dbg) WRITE(ipslout,*) c_nam//" 0.0"
 !-
 ! Search for a free index
@@ -358 +358 @@
 ! 1.0 Transfering into the common for future use
 !-
-  IF (l_dbg) WRITE(*,*) c_nam//" 1.0"
+  IF (l_dbg) WRITE(ipslout,*) c_nam//" 1.0"
 !-
   W_F(idf)%itau0  = pitau0
@@ -366 +366 @@
 ! 2.0 Initializes all variables for this file
 !-
-  IF (l_dbg) WRITE(*,*) c_nam//" 2.0"
+  IF (l_dbg) WRITE(ipslout,*) c_nam//" 2.0"
 !-
   W_F(idf)%n_var = 0
@@ -383 +383 @@
 ! 3.0 Opening netcdf file and defining dimensions
 !-
-  IF (l_dbg) WRITE(*,*) c_nam//" 3.0"
+  IF (l_dbg) WRITE(ipslout,*) c_nam//" 3.0"
 !-
 ! Add DOMAIN number and ".nc" suffix in file name if needed
@@ -425 +425 @@
 ! 4.0 Declaring the geographical coordinates and other attributes
 !-
-  IF (l_dbg) WRITE(*,*) c_nam//" 4.0"
+  IF (l_dbg) WRITE(ipslout,*) c_nam//" 4.0"
 !-
   iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'Conventions','CF-1.1')
@@ -436 +436 @@
 ! 5.0 Saving some important information on this file in the common
 !-
-  IF (l_dbg) WRITE(*,*) c_nam//" 5.0"
+  IF (l_dbg) WRITE(ipslout,*) c_nam//" 5.0"
 !-
   IF (PRESENT(domain_id)) THEN
@@ -612 +612 @@
 ! 1.1 Create all the variables needed
 !-
-  IF (l_dbg) WRITE(*,*) c_nam//" 1.0"
+  IF (l_dbg) WRITE(ipslout,*) c_nam//" 1.0"
 !-
   nfid = W_F(idf)%ncfid
@@ -671 +671 @@
 ! 2.0 Longitude
 !-
-  IF (l_dbg) WRITE(*,*) c_nam//" 2.0"
+  IF (l_dbg) WRITE(ipslout,*) c_nam//" 2.0"
 !-
   i_s = 1;
@@ -702 +702 @@
 ! 3.0 Latitude
 !-
-  IF (l_dbg) WRITE(*,*) c_nam//" 3.0"
+  IF (l_dbg) WRITE(ipslout,*) c_nam//" 3.0"
 !-
   i_e = 2;
@@ -736 +736 @@
 ! 4.0 storing the geographical coordinates
 !-
-  IF (l_dbg) WRITE(*,*) c_nam//" 4.0"
+  IF (l_dbg) WRITE(ipslout,*) c_nam//" 4.0"
 !-
   IF ( (k_typ == 1).OR.(k_typ == 2) ) THEN
@@ -833 +833 @@
 !    Is the name already in use ?
 !-
-  IF (l_dbg) WRITE(*,*) "histvert : 1.0 Verifications", &
+  IF (l_dbg) WRITE(ipslout,*) "histvert : 1.0 Verifications", &
  &                      pzaxname,'---',pzaxunit,'---',pzaxtitle
 !-
@@ -883 +883 @@
 !-
   IF (l_dbg) &
- &  WRITE(*,*) "histvert : 2.0 Add the information to the file"
+ &  WRITE(ipslout,*) "histvert : 2.0 Add the information to the file"
 !-
   nfid = W_F(idf)%ncfid
@@ -918 +918 @@
 !-
   IF (l_dbg) &
-  &  WRITE(*,*) "histvert : 3.0 add the information to the common"
+  &  WRITE(ipslout,*) "histvert : 3.0 add the information to the common"
 !-
   W_F(idf)%n_zax = iv
@@ -1016 +1016 @@
 !     and verify that it does not already exist
 !-
-  IF (l_dbg) WRITE(*,*) "histdef : 1.0"
+  IF (l_dbg) WRITE(ipslout,*) "histdef : 1.0"
 !-
   IF (iv > 1) THEN
@@ -1070 +1070 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "histdef : 2.0",idf,iv,W_F(idf)%W_V(iv)%nbopp, &
+    WRITE(ipslout,*) "histdef : 2.0",idf,iv,W_F(idf)%W_V(iv)%nbopp, &
  &    W_F(idf)%W_V(iv)%sopp(1:W_F(idf)%W_V(iv)%nbopp), &
  &    W_F(idf)%W_V(iv)%scal(1:W_F(idf)%W_V(iv)%nbopp)
@@ -1164 +1164 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "histdef : 3.0"
+    WRITE(ipslout,*) "histdef : 3.0"
   ENDIF
 !-
@@ -1177 +1177 @@
     W_F(idf)%W_V(iv)%t_bf(:) = 0.
     IF (l_dbg) THEN
-      WRITE(*,*) "histdef : 3.0 allocating time_buffer for", &
+      WRITE(ipslout,*) "histdef : 3.0 allocating time_buffer for", &
  &      " idf = ",idf," iv = ",iv," size = ",buff_sz
     ENDIF
@@ -1187 +1187 @@
 !     The strategy is to bring it back to seconds for the tests
 !-
-  IF (l_dbg) WRITE(*,*) "histdef : 4.0"
+  IF (l_dbg) WRITE(ipslout,*) "histdef : 4.0"
 !-
   W_F(idf)%W_V(iv)%freq_opp = pfreq_opp
@@ -1272 +1272 @@
 ! 5.0 Initialize other variables of the common
 !-
-  IF (l_dbg) WRITE(*,*) "histdef : 5.0"
+  IF (l_dbg) WRITE(ipslout,*) "histdef : 5.0"
 !-
   W_F(idf)%W_V(iv)%hist_wrt_rng = (PRESENT(var_range))
@@ -1298 +1298 @@
 ! 6.0 Get the time axis for this variable
 !-
-  IF (l_dbg) WRITE(*,*) "histdef : 6.0"
+  IF (l_dbg) WRITE(ipslout,*) "histdef : 6.0"
 !-
 ! No time axis for once, l_max, l_min or never operation
@@ -1331 +1331 @@
   ELSE
     IF (l_dbg) THEN
-      WRITE(*,*) "histdef : 7.0 ",TRIM(W_F(idf)%W_V(iv)%topp),'----'
+      WRITE(ipslout,*) "histdef : 7.0 ",TRIM(W_F(idf)%W_V(iv)%topp),'----'
     ENDIF
     W_F(idf)%W_V(iv)%t_axid = -99
@@ -1385 +1385 @@
 ! 1.0 Create the time axes
 !-
-  IF (l_dbg) WRITE(*,*) "histend : 1.0"
+  IF (l_dbg) WRITE(ipslout,*) "histend : 1.0"
 !-
 ! 1.1 Define the time dimensions needed for this file
@@ -1473 +1473 @@
 ! 2.0 declare the variables
 !-
-  IF (l_dbg) WRITE(*,*) "histend : 2.0"
+  IF (l_dbg) WRITE(ipslout,*) "histend : 2.0"
 !-
   DO iv=1,W_F(idf)%n_var
@@ -1575 +1575 @@
 !-
         IF (l_dbg) THEN
-          WRITE(*,*) "histend : 2.0.n, freq_opp, freq_wrt", &
+          WRITE(ipslout,*) "histend : 2.0.n, freq_opp, freq_wrt", &
  &          W_F(idf)%W_V(iv)%freq_opp,W_F(idf)%W_V(iv)%freq_wrt
         ENDIF
@@ -1596 +1596 @@
 ! 3.0 Put the netcdf file into write mode
 !-
-  IF (l_dbg) WRITE(*,*) "histend : 3.0"
+  IF (l_dbg) WRITE(ipslout,*) "histend : 3.0"
 !-
   iret = NF90_ENDDEF (nfid)
@@ -1602 +1602 @@
 ! 4.0 Give some informations to the user
 !-
-  IF (l_dbg) WRITE(*,*) "histend : 4.0"
+  IF (l_dbg) WRITE(ipslout,*) "histend : 4.0"
 !-
   WRITE(str70,'("All variables have been initialized on file :",I3)') idf
@@ -1682 +1682 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "histwrite : ",c_nam
+    WRITE(ipslout,*) "histwrite : ",c_nam
   ENDIF
 !-
@@ -1791 +1791 @@
     IF (.NOT.ALLOCATED(tbf_1)) THEN
       IF (l_dbg) THEN
-        WRITE(*,*) &
+        WRITE(ipslout,*) &
  &       c_nam//" : allocate tbf_1 for size = ", &
  &       W_F(idf)%W_V(iv)%datasz_max
@@ -1798 +1798 @@
     ELSE IF (W_F(idf)%W_V(iv)%datasz_max > SIZE(tbf_1)) THEN
       IF (l_dbg) THEN
-        WRITE(*,*) &
+        WRITE(ipslout,*) &
  &       c_nam//" : re-allocate tbf_1 for size = ", &
  &       W_F(idf)%W_V(iv)%datasz_max
@@ -1871 +1871 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "histwrite 0.0 : VAR : ",W_F(idf)%W_V(iv)%v_name
-    WRITE(*,*) "histwrite 0.0 : nbindex :",nbindex
-    WRITE(*,*) "histwrite 0.0 : nindex  :",nindex(1:MIN(3,nbindex)),'...'
+    WRITE(ipslout,*) "histwrite 0.0 : VAR : ",W_F(idf)%W_V(iv)%v_name
+    WRITE(ipslout,*) "histwrite 0.0 : nbindex :",nbindex
+    WRITE(ipslout,*) "histwrite 0.0 : nindex  :",nindex(1:MIN(3,nbindex)),'...'
   ENDIF
 !-
@@ -1888 +1888 @@
   IF (.NOT.ALLOCATED(tbf_2)) THEN
     IF (l_dbg) THEN
-      WRITE(*,*) "histwrite_real 1.1 allocate tbf_2 ",SIZE(tbf_1)
+      WRITE(ipslout,*) "histwrite_real 1.1 allocate tbf_2 ",SIZE(tbf_1)
     ENDIF
     ALLOCATE(tbf_2(W_F(idf)%W_V(iv)%datasz_max))
   ELSE IF (W_F(idf)%W_V(iv)%datasz_max > SIZE(tbf_2)) THEN
     IF (l_dbg) THEN
-      WRITE(*,*) "histwrite_real 1.2 re-allocate tbf_2 : ", &
+      WRITE(ipslout,*) "histwrite_real 1.2 re-allocate tbf_2 : ", &
      & SIZE(tbf_1)," instead of ",SIZE(tbf_2)
     ENDIF
@@ -1906 +1906 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "histwrite: 3.0",idf
+    WRITE(ipslout,*) "histwrite: 3.0",idf
   ENDIF
 !-
@@ -1924 +1924 @@
  &      nbout,tbf_2)
       IF (l_dbg) THEN
-        WRITE(*,*) &
+        WRITE(ipslout,*) &
  &       "histwrite: 3.4a nbout : ",nbin,nbout,W_F(idf)%W_V(iv)%sopp(io)
       ENDIF
@@ -1934 +1934 @@
  &      nbout,tbf_1)
       IF (l_dbg) THEN
-        WRITE(*,*) &
+        WRITE(ipslout,*) &
  &     "histwrite: 3.4b nbout : ",nbin,nbout,W_F(idf)%W_V(iv)%sopp(io+1)
       ENDIF
@@ -1942 +1942 @@
 !-
     IF (l_dbg) THEN
-      WRITE(*,*) &
+      WRITE(ipslout,*) &
  &     "histwrite: 3.5 size(tbf_1) : ",SIZE(tbf_1)
-      WRITE(*,*) &
+      WRITE(ipslout,*) &
  &     "histwrite: 3.5 slab in X :", &
  &     W_F(idf)%W_V(iv)%zorig(1),W_F(idf)%W_V(iv)%zsize(1)
-      WRITE(*,*) &
+      WRITE(ipslout,*) &
  &     "histwrite: 3.5 slab in Y :", &
  &     W_F(idf)%W_V(iv)%zorig(2),W_F(idf)%W_V(iv)%zsize(2)
-      WRITE(*,*) &
+      WRITE(ipslout,*) &
  &     "histwrite: 3.5 slab in Z :", &
  &     W_F(idf)%W_V(iv)%zorig(3),W_F(idf)%W_V(iv)%zsize(3)
-      WRITE(*,*) &
+      WRITE(ipslout,*) &
  &     "histwrite: 3.5 slab of input:", &
  &     W_F(idf)%W_V(iv)%scsize(1), &
@@ -1999 +1999 @@
 !-
     IF (l_dbg) THEN
-      WRITE(*,*) "histwrite: 4.0 tbf_1",idf,iv, &
+      WRITE(ipslout,*) "histwrite: 4.0 tbf_1",idf,iv, &
  &      TRIM(tmp_opp),' ---- ',LEN_TRIM(tmp_opp),nbindex
     ENDIF
@@ -2016 +2016 @@
 !-
     IF (l_dbg) THEN
-      WRITE(*,*) "histwrite: 5.0 idf : ",idf," iv : ",iv," tsz : ",tsz
+      WRITE(ipslout,*) "histwrite: 5.0 idf : ",idf," iv : ",iv," tsz : ",tsz
     ENDIF
 !-
@@ -2032 +2032 @@
 ! 6.0 Write to file if needed
 !-
-  IF (l_dbg) WRITE(*,*) "histwrite: 6.0",idf
+  IF (l_dbg) WRITE(ipslout,*) "histwrite: 6.0",idf
 !-
   IF (do_write) THEN
@@ -2041 +2041 @@
 !-- 6.1 Do the operations that are needed before writting
 !-
-    IF (l_dbg) WRITE(*,*) "histwrite: 6.1",idf
+    IF (l_dbg) WRITE(ipslout,*) "histwrite: 6.1",idf
 !-
     IF (     (TRIM(tmp_opp) /= "inst") &
@@ -2055 +2055 @@
  &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
 !-
-      IF (l_dbg) WRITE(*,*) "histwrite: 6.2",idf
+      IF (l_dbg) WRITE(ipslout,*) "histwrite: 6.2",idf
 !-
       itax  = W_F(idf)%W_V(iv)%t_axid
@@ -2077 +2077 @@
 !-
     IF (l_dbg) THEN
-      WRITE(*,*) "histwrite: 6.3",idf,nfid,nvid,iv,itime
+      WRITE(ipslout,*) "histwrite: 6.3",idf,nfid,nvid,iv,itime
     ENDIF
 !-
@@ -2159 +2159 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) 'histvar_seq, start of the subroutine :',learning(idf)
+    WRITE(ipslout,*) 'histvar_seq, start of the subroutine :',learning(idf)
   ENDIF
 !-
@@ -2203 +2203 @@
  &       'of your code. Thus if you wish to save time'// &
  &       ' contact the IOIPSL team. ')
-        WRITE(*,*) 'The sequence we have found up to now :'
-        WRITE(*,*) varseq(idf,1:sp-1)
+        WRITE(ipslout,*) 'The sequence we have found up to now :'
+        WRITE(ipslout,*) varseq(idf,1:sp-1)
         varseq_err(idf) = -1
       ENDIF
@@ -2268 +2268 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) &
+    WRITE(ipslout,*) &
  &   'histvar_seq, end of the subroutine :',TRIM(pvarname),idv
   ENDIF
@@ -2294 +2294 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->histsync"
+    WRITE(ipslout,*) "->histsync"
   ENDIF
 !-
@@ -2319 +2319 @@
     IF (W_F(ifile)%ncfid > 0) THEN
       IF (l_dbg) THEN
-        WRITE(*,*) '  histsync - synchronising file number ',ifile
+        WRITE(ipslout,*) '  histsync - synchronising file number ',ifile
       ENDIF
       iret = NF90_SYNC(W_F(ifile)%ncfid)
@@ -2326 +2326 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-histsync"
+    WRITE(ipslout,*) "<-histsync"
   ENDIF
 !----------------------
@@ -2349 +2349 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->histclo"
+    WRITE(ipslout,*) "->histclo"
   ENDIF
 !-
@@ -2374 +2374 @@
     IF (W_F(ifile)%ncfid > 0) THEN
       IF (l_dbg) THEN
-        WRITE(*,*) '  histclo - closing specified file number :',ifile
+        WRITE(ipslout,*) '  histclo - closing specified file number :',ifile
       ENDIF
       nfid = W_F(ifile)%ncfid
@@ -2382 +2382 @@
 !-----
       IF (l_dbg) THEN
-        WRITE(*,*) '  Entering loop on vars : ',W_F(ifile)%n_var
+        WRITE(ipslout,*) '  Entering loop on vars : ',W_F(ifile)%n_var
       ENDIF
       DO iv=1,W_F(ifile)%n_var
@@ -2388 +2388 @@
         IF (W_F(ifile)%W_V(iv)%hist_wrt_rng) THEN
           IF (l_dbg) THEN
-            WRITE(*,*) 'min value for file :',ifile,' var n. :',iv, &
+            WRITE(ipslout,*) 'min value for file :',ifile,' var n. :',iv, &
  &                     ' is : ',W_F(ifile)%W_V(iv)%hist_minmax(1)
-            WRITE(*,*) 'max value for file :',ifile,' var n. :',iv, &
+            WRITE(ipslout,*) 'max value for file :',ifile,' var n. :',iv, &
  &                     ' is : ',W_F(ifile)%W_V(iv)%hist_minmax(2)
           ENDIF
@@ -2420 +2420 @@
 !---- 2. Close the file
 !-----
-      IF (l_dbg) WRITE(*,*) '  close file :',nfid
+      IF (l_dbg) WRITE(ipslout,*) '  close file :',nfid
       iret = NF90_CLOSE(nfid)
       W_F(ifile)%ncfid = -1
@@ -2428 +2428 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-histclo"
+    WRITE(ipslout,*) "<-histclo"
   ENDIF
 !---------------------