Changeset 3907 for dynamico_lmdz/aquaplanet/IOIPSL

Timestamp:

Feb 11, 2016, 3:01:01 PM (9 years ago)

Author:

ymipsl

Message:

Compilation of IOIPSL is now made by FCM

YM

Location:

dynamico_lmdz/aquaplanet/IOIPSL

Files:

• IOIPSL_src.tar (deleted)
• arch (added)
• bld.cfg (added)
• build (added)
• makeioipsl_fcm (added)
• rebuild_src (deleted)
• src/AA_make (deleted)
• src/AA_make.ldef (deleted)
• src/CVS (deleted)
• src/Makefile (deleted)
• src/Makefile.sx6 (deleted)
• src/calendar.f90 (modified) (6 diffs)
• src/calendar.mod (deleted)
• src/combinelle.c (deleted)
• src/defprec.mod (deleted)
• src/errioipsl.f90 (modified) (5 diffs)
• src/errioipsl.mod (deleted)
• src/flincom.f90 (modified) (52 diffs)
• src/flincom.mod (deleted)
• src/fliocom.f90 (modified) (70 diffs)
• src/fliocom.mod (deleted)
• src/getincom.f90 (modified) (75 diffs)
• src/getincom.mod (deleted)
• src/histcom.f90 (modified) (61 diffs)
• src/histcom.f90_old (deleted)
• src/histcom.mod (deleted)
• src/ioipsl.mod (deleted)
• src/mathelp.f90 (modified) (3 diffs)
• src/mathelp.mod (deleted)
• src/out (deleted)
• src/restcom.f90 (modified) (56 diffs)
• src/restcom.mod (deleted)
• src/stringop.mod (deleted)

dynamico_lmdz/aquaplanet/IOIPSL/src/calendar.f90

@@ -1 +1 @@
 MODULE calendar
 !-
-!$Id: calendar.f90 1011 2010-05-07 13:05:34Z bellier $
+!$Id: calendar.f90 1519 2011-08-01 09:34:10Z mmaipsl $
 !-
 ! This software is governed by the CeCILL license
@@ -40 +40 @@
 !---------------------------------------------------------------------
   USE stringop,ONLY  : strlowercase
-  USE errioipsl,ONLY : ipslerr
+  USE errioipsl,ONLY : ipslerr, ipsldbg, ipslout
 !-
   PRIVATE
@@ -354 +354 @@
     tmp_str = input_str
     DO WHILE ( MAX(y_pos,m_pos,d_pos,s_pos) > 0)
-!---- WRITE(*,*) tmp_str
-!---- WRITE(*,*) y_pos,m_pos,d_pos,s_pos
+!---- WRITE(ipslout,*) tmp_str
+!---- WRITE(ipslout,*) y_pos,m_pos,d_pos,s_pos
       IF (y_pos > 0) THEN
         WRITE(fmt,'("(I",I10.10,")")') y_pos-1
@@ -530 +530 @@
   INTEGER :: yearp,dayp
   REAL :: sec,secp
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
-  IF (check) THEN
-    WRITE(*,*) &
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!---------------------------------------------------------------------
+  IF (l_dbg) THEN
+    WRITE(ipslout,*) &
  &    "isittime 1.0 ",itau,date0,dt,freq,last_action,last_check
   ENDIF
@@ -604 +606 @@
  &        <= ABS( next_check_itau-next_act_itau)) THEN
         do_action = .TRUE.
-        IF (check) THEN
-          WRITE(*,*) &
+        IF (l_dbg) THEN
+          WRITE(ipslout,*) &
  &         'ACT-TIME : itau, next_act_itau, next_check_itau : ', &
  &         itau,next_act_itau,next_check_itau
           CALL ju2ymds (date_now,year,month,day,sec)
-          WRITE(*,*) 'ACT-TIME : y, m, d, s : ',year,month,day,sec
-          WRITE(*,*) &
+          WRITE(ipslout,*) 'ACT-TIME : y, m, d, s : ',year,month,day,sec
+          WRITE(ipslout,*) &
  &         'ACT-TIME : date_mp1, date_mpf : ',date_mp1,date_mpf
         ENDIF
@@ -618 +620 @@
     ENDIF
 !-
-    IF (check) THEN
-      WRITE(*,*) "isittime 2.0 ", &
+    IF (l_dbg) THEN
+      WRITE(ipslout,*) "isittime 2.0 ", &
  &     date_next_check,date_next_act,ABS(dt_action-freq), &
  &     ABS(dt_action+dt_check-freq),dt_action,dt_check, &

dynamico_lmdz/aquaplanet/IOIPSL/src/errioipsl.f90

@@ -1 +1 @@
 MODULE errioipsl
 !-
-!$Id: errioipsl.f90 759 2009-10-22 08:53:27Z bellier $
+!$Id: errioipsl.f90 2079 2013-06-03 09:14:13Z jgipsl $
 !-
 ! This software is governed by the CeCILL license
@@ -10 +10 @@
 PRIVATE
 !-
-PUBLIC :: ipslnlf, ipslerr, ipslerr_act, ipslerr_inq, histerr, ipsldbg
-!-
-  INTEGER :: n_l=6, ilv_cur=0, ilv_max=0
+PUBLIC :: ipslnlf, ipslerr, ipslerr_act, ipslerr_inq, histerr, ipsldbg, ipslout
+!-
+  INTEGER :: ipslout=6, ilv_cur=0, ilv_max=0
   LOGICAL :: ioipsl_debug=.FALSE., lact_mode=.TRUE.
 !-
@@ -39 +39 @@
 !---------------------------------------------------------------------
   IF (PRESENT(old_number)) THEN
-    old_number = n_l
+    old_number = ipslout
   ENDIF
   IF (PRESENT(new_number)) THEN
-    n_l = new_number
+    ipslout = new_number
   ENDIF
 !---------------------
@@ -76 +76 @@
      ilv_cur = plev
      ilv_max = MAX(ilv_max,plev)
-     WRITE(n_l,'(/,A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
-     WRITE(n_l,'(3(" --> ",A,/))') TRIM(pstr1),TRIM(pstr2),TRIM(pstr3)
+     WRITE(ipslout,'(/,A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+     WRITE(ipslout,'(3(" --> ",A,/))') TRIM(pstr1),TRIM(pstr2),TRIM(pstr3)
    ENDIF
    IF ( (plev == 3).AND.lact_mode) THEN
-     WRITE(n_l,'("Fatal error from IOIPSL. STOP in ipslerr with code")')
+     WRITE(ipslout,'("Fatal error from IOIPSL. STOP in ipslerr with code")')
      STOP 1
    ENDIF
@@ -177 +177 @@
    ENDIF
    IF (plev == 3) THEN
-     STOP 'Fatal error from IOIPSL. See stdout for more details'
+     WRITE(ipslout,'("Fatal error from IOIPSL. See stdout for more details")')
+     STOP 1 
    ENDIF
 !---------------------

dynamico_lmdz/aquaplanet/IOIPSL/src/flincom.f90

@@ -1 +1 @@
 MODULE flincom
 !-
-!$Id: flincom.f90 427 2008-10-16 07:55:13Z bellier $
+!$Id: flincom.f90 1932 2012-11-28 09:56:17Z jgipsl $
 !-
 ! This software is governed by the CeCILL license
@@ -9 +9 @@
 !-
   USE calendar,  ONLY : ju2ymds, ymds2ju, ioconf_calendar
-  USE errioipsl, ONLY : histerr
+  USE errioipsl, ONLY : histerr, ipslout,ipslerr,ipsldbg
   USE stringop,  ONLY : strlowercase
 !-
@@ -175 +175 @@
   CHARACTER(LEN=250):: name
 !-
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+
   lll = LEN_TRIM(filename)
   IF (filename(lll-2:lll) /= '.nc') THEN
@@ -193 +195 @@
 ! Vertical axis
 !-
-  IF (check) WRITE(*,*) 'flincre Vertical axis'
+  IF (l_dbg) WRITE(ipslout,*) 'flincre Vertical axis'
 !-
   iret = NF90_DEF_VAR (fid, 'lev', NF90_FLOAT, zdimid1, levid)
@@ -202 +204 @@
 ! Time axis
 !-
-  IF (check) WRITE(*,*) 'flincre time axis'
+  IF (l_dbg) WRITE(ipslout,*) 'flincre time axis'
 !-
   iret = NF90_DEF_VAR (fid, 'tstep', NF90_FLOAT, tdimid1, timeid)
@@ -211 +213 @@
 ! The longitude
 !-
-  IF (check) WRITE(*,*) 'flincre Longitude axis'
+  IF (l_dbg) WRITE(ipslout,*) 'flincre Longitude axis'
 !-
   iret = NF90_DEF_VAR (fid, "nav_lon", NF90_FLOAT, &
@@ -226 +228 @@
 ! The Latitude
 !-
-  IF (check) WRITE(*,*) 'flincre Latitude axis'
+  IF (l_dbg) WRITE(ipslout,*) 'flincre Latitude axis'
 !-
   iret = NF90_DEF_VAR (fid, "nav_lat", NF90_FLOAT, &
@@ -253 +255 @@
   iret = NF90_ENDDEF (fid)
 !-
-  IF (check) WRITE(*,*) 'flincre Variable'
+  IF (l_dbg) WRITE(ipslout,*) 'flincre Variable'
 !-
   iret = NF90_PUT_VAR (fid, levid, lev1(1:llm1))
 !-
-  IF (check) WRITE(*,*) 'flincre Time Variable'
+  IF (l_dbg) WRITE(ipslout,*) 'flincre Time Variable'
 !-
   iret = NF90_PUT_VAR (fid, timeid, REAL(itaus(1:ttm1)))
 !-
-  IF (check) WRITE(*,*) 'flincre Longitude'
+  IF (l_dbg) WRITE(ipslout,*) 'flincre Longitude'
 !-
   iret = NF90_PUT_VAR (fid, lonid, lon1(1:iim1,1:jjm1))
 !-
-  IF (check) WRITE(*,*) 'flincre Latitude'
+  IF (l_dbg) WRITE(ipslout,*) 'flincre Latitude'
 !-
   iret = NF90_PUT_VAR (fid, latid, lat1(1:iim1,1:jjm1))
@@ -311 +313 @@
   INTEGER :: fid_out
 !-
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
-  IF (check) WRITE (*,*) ' iideb, iilen, jjdeb, jjlen, iim, jjm ', &
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+
+  IF (l_dbg) WRITE (*,*) ' iideb, iilen, jjdeb, jjlen, iim, jjm ', &
                            iideb, iilen, jjdeb, jjlen, iim, jjm
-  IF (check) WRITE (*,*) ' lon ', lon(1,1), lon(iilen,jjlen)
-  IF (check) WRITE (*,*) ' lat ', lat(1,1), lat(iilen,jjlen)
+  IF (l_dbg) WRITE (*,*) ' lon ', lon(1,1), lon(iilen,jjlen)
+  IF (l_dbg) WRITE (*,*) ' lat ', lat(1,1), lat(iilen,jjlen)
 !-
   CALL flinopen_work &
@@ -341 +345 @@
   REAL :: date0, dt
   INTEGER :: fid_out
-!---------------------------------------------------------------------
+  INTEGER :: iimc, jjmc
+!---------------------------------------------------------------------
+  iimc=iim
+  jjmc=jjm
   CALL flinopen_work &
-    (filename, 1, iim, 1, jjm, do_test, &
+    (filename, 1, iimc, 1, jjmc, do_test, &
      iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
 !-------------------------
@@ -385 +392 @@
 !-
   LOGICAL :: open_file
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+
   iilast = iideb+iilen-1
   jjlast = jjdeb+jjlen-1
-  IF (check) WRITE (*,*) &
+  IF (l_dbg) WRITE (*,*) &
     ' flinopen_work zoom 2D information '// &
     ' iideb, iilen, iilast, jjdeb, jjlen, jjlast ', &
@@ -419 +428 @@
   ENDIF
 !-
-  IF (check) &
-    WRITE(*,*) 'OUT OF flininfo :',tmp_iim,tmp_jjm,tmp_llm,tmp_ttm
+  IF (l_dbg) &
+    WRITE(ipslout,*) 'OUT OF flininfo :',tmp_iim,tmp_jjm,tmp_llm,tmp_ttm
 !-
   fid = ncids(fid_out)
@@ -429 +438 @@
 ! 2.2 We test the axis if we have to.
 !-
-  IF (check) &
-    WRITE(*,*) 'flininfo 2.2 We test if we have to test : ',do_test
+  IF (l_dbg) &
+    WRITE(ipslout,*) 'flininfo 2.2 We test if we have to test : ',do_test
 !-
   IF (do_test) THEN
@@ -450 +459 @@
 !-- 2.3 Else the sizes of the axes are returned to the user
 !---
-    IF (check) WRITE(*,*) 'flinopen 2.3 Else sizes are returned'
+    IF (l_dbg) WRITE(ipslout,*) 'flinopen 2.3 Else sizes are returned'
 !---
     iim = tmp_iim
@@ -462 +471 @@
 !     if not then we get the lon, lat and lev variables from the file
 !-
-  IF (check) WRITE(*,*) 'flinopen 3.0 we are realy talking'
+  IF (l_dbg) WRITE(ipslout,*) 'flinopen 3.0 we are realy talking'
 !-
   IF (do_test) THEN
@@ -470 +479 @@
     iret = NF90_GET_VAR (fid, vid, x_last, start=(/ iilast, jjlast /))
 !---
-    IF (check) &
-      WRITE(*,*) 'from file lon first and last, modulo 360. ', &
+    IF (l_dbg) &
+      WRITE(ipslout,*) 'from file lon first and last, modulo 360. ', &
         x_first, x_last, MODULO(x_first,360.), MODULO(x_last,360.)
-    IF (check) &
-      WRITE(*,*) 'from model lon first and last, modulo 360. ', &
+    IF (l_dbg) &
+      WRITE(ipslout,*) 'from model lon first and last, modulo 360. ', &
         lon(1,1),lon(iilen,jjlen), &
         MODULO(lon(1,1),360.), MODULO(lon(iilen,jjlen),360.)
@@ -491 +500 @@
     iret = NF90_GET_VAR (fid, vid, x_last, start=(/ iilast, jjlast /))
 !---
-    IF (check) WRITE(*,*) &
+    IF (l_dbg) WRITE(ipslout,*) &
       'from file lat first and last ',x_first,x_last
-    IF (check) WRITE(*,*) &
+    IF (l_dbg) WRITE(ipslout,*) &
       'from model lat first and last ',lat(1,1),lat(iilen,jjlen)
 !---
@@ -509 +518 @@
       iret = NF90_GET_VAR (fid, vid, x_last, start=(/ llm /))
 !-----
-      IF (check) WRITE(*,*) &
+      IF (l_dbg) WRITE(ipslout,*) &
         'from file lev first and last ',x_first ,x_last
-      IF (check) WRITE(*,*) &
+      IF (l_dbg) WRITE(ipslout,*) &
         'from model lev first and last ',lev(1),lev(llm)
 !-----
@@ -527 +536 @@
 !-- 4.0 extracting the coordinates if we do not check
 !---
-    IF (check) WRITE(*,*) 'flinopen 4.0 extracting the coordinates'
+    IF (l_dbg) WRITE(ipslout,*) 'flinopen 4.0 extracting the coordinates'
 !---
     CALL flinfindcood (fid_out, 'lon', vid, nbdim)
@@ -572 +581 @@
 ! 5.0 Get all the details for the time if possible needed
 !-
-  IF (check) WRITE(*,*) 'flinopen 5.0 Get time'
+  IF (l_dbg) WRITE(ipslout,*) 'flinopen 5.0 Get time'
 !-
   IF (ttm > 0) THEN
@@ -588 +597 @@
       IF (INDEX(units,'seconds since') > 0) gdtmaf_id = iv
       IF (INDEX(units,'timesteps since') > 0) gdtt_id = iv
-      IF (INDEX(name, 'tstep') > 0) old_id = iv
+      IF (INDEX(name, 'tstep') > 0 .OR. INDEX(name,'time') > 0 ) old_id = iv
     ENDDO
 !---
@@ -606 +615 @@
     DEALLOCATE(vec_tmp)
 !---
-    IF (check) WRITE(*,*) 'flinopen 5.1 Times ',itaus
+    IF (l_dbg) WRITE(ipslout,*) 'flinopen 5.1 Times ',itaus
 !---
 !-- Getting all the details for the time axis
@@ -626 +635 @@
       sec0 = hours0*3600. + minutes0*60. + seci
       CALL ymds2ju (year0, month0, day0, sec0, date0)
-      IF (check) &
-        WRITE(*,*) 'flinopen 5.1 gdtt_id year0 ... date0 ', &
+      IF (l_dbg) &
+        WRITE(ipslout,*) 'flinopen 5.1 gdtt_id year0 ... date0 ', &
                    year0, month0, day0, sec0, date0
 !-----
@@ -639 +648 @@
       CALL ymds2ju (year0, month0, day0, sec0, date0)
 !-----
-      IF (check) &
-        WRITE(*,*) 'flinopen 5.1 gdtmaf_id year0 ... date0 ', &
+      IF (l_dbg) &
+        WRITE(ipslout,*) 'flinopen 5.1 gdtmaf_id year0 ... date0 ', &
                    year0, month0, day0, sec0, date0
     ELSE IF (old_id > 0) THEN
@@ -657 +666 @@
   ENDIF
 !-
-  IF (check) WRITE(*,*) 'flinopen 6.0 File opened', date0, dt
+  IF (l_dbg) WRITE(ipslout,*) 'flinopen 6.0 File opened', date0, dt
 !---------------------------
 END SUBROUTINE flinopen_work
@@ -685 +694 @@
   CHARACTER(LEN=30) :: axname
 !-
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+
   lll = LEN_TRIM(filename)
   IF (filename(lll-2:lll) /= '.nc') THEN
@@ -713 +724 @@
     axname = ADJUSTL(axname)
 !---
-    IF (check) WRITE(*,*) &
+    IF (l_dbg) WRITE(ipslout,*) &
       'flininfo - getting axname',iv,axname,lll
 !---
@@ -728 +739 @@
       zid = iv; llm = lll;
     ELSE IF (    (INDEX(axname,'tstep') == 1) &
+             .OR.(INDEX(axname,'time') == 1) &
              .OR.(INDEX(axname,'time_counter') == 1) ) THEN
 !---- For the time we certainly need to allow for other names
@@ -775 +787 @@
 !-
   INTEGER :: fid, ncvarid, ndim, iret
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
-  IF (check) WRITE(*,*) &
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+
+  IF (l_dbg) WRITE(ipslout,*) &
      "flinput_r1d : SIZE(var) = ",SIZE(var)
 !-
@@ -802 +816 @@
 !-
   INTEGER :: fid, ncvarid, ndim, iret
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
-  IF (check) WRITE(*,*) &
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+
+  IF (l_dbg) WRITE(ipslout,*) &
      "flinput_r2d : SIZE(var) = ",SIZE(var)
 !-
@@ -829 +845 @@
 !-
   INTEGER :: fid, ncvarid, ndim, iret
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
-  IF (check) WRITE(*,*) &
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+
+  IF (l_dbg) WRITE(ipslout,*) &
      "flinput_r3d : SIZE(var) = ",SIZE(var)
 !-
@@ -856 +874 @@
 !-
   INTEGER :: fid, ncvarid, ndim, iret
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
-  IF (check) WRITE(*,*) &
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+
+  IF (l_dbg) WRITE(ipslout,*) &
      "flinput_r4d : SIZE(var) = ",SIZE(var)
 !-
@@ -955 +975 @@
   INTEGER :: jl, ji
   REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+
   IF (.NOT.ALLOCATED(buff_tmp)) THEN
-    IF (check) WRITE(*,*) &
+    IF (l_dbg) WRITE(ipslout,*) &
       "flinget_r1d : allocate buff_tmp for buff_sz = ",SIZE(var)
     ALLOCATE (buff_tmp(SIZE(var)))
   ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
-    IF (check) WRITE(*,*) &
+    IF (l_dbg) WRITE(ipslout,*) &
       "flinget_r1d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
     DEALLOCATE (buff_tmp)
@@ -993 +1015 @@
   INTEGER :: jl, jj, ji
   REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+
   IF (.NOT.ALLOCATED(buff_tmp)) THEN
-    IF (check) WRITE(*,*) &
+    IF (l_dbg) WRITE(ipslout,*) &
       "flinget_r2d : allocate buff_tmp for buff_sz = ",SIZE(var)
     ALLOCATE (buff_tmp(SIZE(var)))
   ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
-    IF (check) WRITE(*,*) &
+    IF (l_dbg) WRITE(ipslout,*) &
       "flinget_r2d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
     DEALLOCATE (buff_tmp)
@@ -1034 +1058 @@
   INTEGER :: jl, jj, ji
   REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+
   IF (.NOT.ALLOCATED(buff_tmp)) THEN
-    IF (check) WRITE(*,*) &
+    IF (l_dbg) WRITE(ipslout,*) &
       "flinget_r2d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)
     ALLOCATE (buff_tmp(SIZE(var)))
   ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
-    IF (check) WRITE(*,*) &
+    IF (l_dbg) WRITE(ipslout,*) &
       "flinget_r2d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)
     DEALLOCATE (buff_tmp)
@@ -1074 +1100 @@
   INTEGER :: jl, jk, jj, ji
   REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+
   IF (.NOT.ALLOCATED(buff_tmp)) THEN
-    IF (check) WRITE(*,*) &
+    IF (l_dbg) WRITE(ipslout,*) &
       "flinget_r3d : allocate buff_tmp for buff_sz = ",SIZE(var)
     ALLOCATE (buff_tmp(SIZE(var)))
   ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
-    IF (check) WRITE(*,*) &
+    IF (l_dbg) WRITE(ipslout,*) &
       "flinget_r3d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
     DEALLOCATE (buff_tmp)
@@ -1117 +1145 @@
   INTEGER :: jl, jk, jj, ji
   REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+
   IF (.NOT.ALLOCATED(buff_tmp)) THEN
-    IF (check) WRITE(*,*) &
+    IF (l_dbg) WRITE(ipslout,*) &
       "flinget_r3d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)
     ALLOCATE (buff_tmp(SIZE(var)))
   ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
-    IF (check) WRITE(*,*) &
+    IF (l_dbg) WRITE(ipslout,*) &
       "flinget_r3d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)
     DEALLOCATE (buff_tmp)
@@ -1159 +1189 @@
   INTEGER :: jl, jk, jj, ji, jm
   REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+
   IF (.NOT.ALLOCATED(buff_tmp)) THEN
-    IF (check) WRITE(*,*) &
+    IF (l_dbg) WRITE(ipslout,*) &
       "flinget_r4d : allocate buff_tmp for buff_sz = ",SIZE(var)
     ALLOCATE (buff_tmp(SIZE(var)))
   ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
-    IF (check) WRITE(*,*) &
+    IF (l_dbg) WRITE(ipslout,*) &
       "flinget_r4d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
     DEALLOCATE (buff_tmp)
@@ -1204 +1236 @@
   INTEGER :: jl, jk, jj, ji, jm
   REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+
   IF (.NOT.ALLOCATED(buff_tmp)) THEN
-    IF (check) WRITE(*,*) &
+    IF (l_dbg) WRITE(ipslout,*) &
       "flinget_r4d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)
     ALLOCATE (buff_tmp(SIZE(var)))
   ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
-    IF (check) WRITE(*,*) &
+    IF (l_dbg) WRITE(ipslout,*) &
       "flinget_r4d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)
     DEALLOCATE (buff_tmp)
@@ -1280 +1314 @@
 ! ARGUMENTS
 !-
-  INTEGER :: fid_in
-  CHARACTER(LEN=*) :: varname
-  INTEGER :: iim, jjm, llm, ttm
-  INTEGER :: itau_dep, itau_fin, iideb, iilen, jjdeb, jjlen
-  REAL :: var(:)
+  INTEGER, INTENT(IN) :: fid_in
+  CHARACTER(LEN=*), INTENT(IN) :: varname
+  INTEGER, INTENT(IN) :: iim, jjm, llm, ttm
+  INTEGER, INTENT(IN) :: itau_dep, itau_fin, iideb, iilen, jjdeb, jjlen
+  REAL, INTENT(OUT) :: var(:)
 !-
 ! LOCAL
@@ -1300 +1334 @@
   INTEGER :: i, nvars, i2d, cnd
   REAL,DIMENSION(:),ALLOCATABLE,SAVE :: var_tmp
+  INTEGER :: itau_len
   LOGICAL :: uncompress = .FALSE.
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
+  INTEGER :: il, ip, i2p, it
+  !-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+  !-
   fid = ncids(fid_in)
 !-
-  IF (check) THEN
-    WRITE(*,*) &
+  IF (l_dbg) THEN
+    WRITE(ipslout,*) &
     'flinget_mat : fid_in, fid, varname :', fid_in, fid, TRIM(varname)
-    WRITE(*,*) &
+    WRITE(ipslout,*) &
     'flinget_mat : iim, jjm, llm, ttm, itau_dep, itau_fin :', &
     iim, jjm, llm, ttm, itau_dep, itau_fin
-    WRITE(*,*) &
+    WRITE(ipslout,*) &
     'flinget_mat : iideb, iilen, jjdeb, jjlen :', &
     iideb, iilen, jjdeb, jjlen
@@ -1332 +1371 @@
   iret = NF90_INQUIRE_VARIABLE (fid, vid, &
            ndims=ndims, dimids=dimids, nAtts=nb_atts)
-  IF (check) THEN
-    WRITE(*,*) &
+  IF (l_dbg) THEN
+    WRITE(ipslout,*) &
     'flinget_mat : fid, vid :', fid, vid
-    WRITE(*,*) &
+    WRITE(ipslout,*) &
     'flinget_mat : ndims, dimids(1:ndims), nb_atts :', &
     ndims, dimids(1:ndims), nb_atts
@@ -1344 +1383 @@
     iret  = NF90_INQUIRE_DIMENSION (fid, dimids(i), len=w_dim(i))
   ENDDO
-  IF (check) WRITE(*,*) &
+  IF (l_dbg) WRITE(ipslout,*) &
     'flinget_mat : w_dim :', w_dim(1:ndims)
 !-
@@ -1350 +1389 @@
 !-
   IF (nb_atts > 0) THEN
-    IF (check) THEN
-      WRITE(*,*) 'flinget_mat : attributes for variable :'
+     IF (l_dbg) THEN
+      WRITE(ipslout,*) 'flinget_mat : attributes for variable :'
     ENDIF
   ENDIF
@@ -1361 +1400 @@
              .OR.(x_typ == NF90_BYTE) ) THEN
       iret = NF90_GET_ATT (fid, vid, att_n, tmp_i)
-      IF (check) THEN
-        WRITE(*,*) '   ',TRIM(att_n),' : ',tmp_i
+        IF (l_dbg) THEN
+        WRITE(ipslout,*) '   ',TRIM(att_n),' : ',tmp_i
       ENDIF
     ELSE IF ( (x_typ == NF90_FLOAT).OR.(x_typ == NF90_DOUBLE) ) THEN
       iret = NF90_GET_ATT (fid, vid, att_n, tmp_r)
-      IF (check) THEN
-        WRITE(*,*) '   ',TRIM(att_n),' : ',tmp_r
+        IF (l_dbg) THEN
+        WRITE(ipslout,*) '   ',TRIM(att_n),' : ',tmp_r
       ENDIF
       IF (index(att_n,'missing_value') > 0) THEN
@@ -1375 +1414 @@
       tmp_n = ''
       iret = NF90_GET_ATT (fid, vid, att_n, tmp_n)
-      IF (check) THEN
-        WRITE(*,*) '   ',TRIM(att_n),' : ',TRIM(tmp_n)
+        IF (l_dbg) THEN
+        WRITE(ipslout,*) '   ',TRIM(att_n),' : ',TRIM(tmp_n)
       ENDIF
       IF (index(att_n,'axis') > 0) THEN
@@ -1399 +1438 @@
     iret = NF90_INQ_VARID (fid, tmp_n, cvid)
 !---
-    IF (check) WRITE(*,*) &
+    IF (l_dbg) WRITE(ipslout,*) &
       'Dimname, iret , NF90_NOERR : ',TRIM(tmp_n),iret,NF90_NOERR
 !---
@@ -1556 +1595 @@
 ! 3.0 Reading the data
 !-
-  IF (check) WRITE(*,*) &
+  IF (l_dbg) WRITE(ipslout,*) &
     'flinget_mat 3.0 : ', uncompress, w_sta, w_len
 !---
+  var(:) = mis_v
   IF (uncompress) THEN
 !---
     IF (ALLOCATED(var_tmp)) THEN
-      IF (SIZE(var_tmp) < clen) THEN
-        DEALLOCATE(var_tmp)
-        ALLOCATE(var_tmp(clen))
+      IF (SIZE(var_tmp) < PRODUCT(w_len(:),mask=(w_len>1))) THEN
+         DEALLOCATE(var_tmp)
+         ALLOCATE(var_tmp(PRODUCT(w_len(:),mask=(w_len>1))))
       ENDIF
     ELSE
-      ALLOCATE(var_tmp(clen))
+      ALLOCATE(var_tmp(PRODUCT(w_len(:),mask=(w_len>1))))
     ENDIF
 !---
@@ -1573 +1613 @@
              start=w_sta(:), count=w_len(:))
 !---
+    itau_len=itau_fin-itau_dep+1
+    IF (l_dbg) WRITE(ipslout,*) 'flinget_mat 3.0 : clen, itau_len ',clen,itau_len
     var(:) = mis_v
-    var(cindex(:)) = var_tmp(:)
+    IF (itau_len > 0) THEN
+       DO it=1,itau_len
+          DO il=1,clen
+             ip = il + (it-1)*clen
+             i2p = cindex(il)+(it-1)*iim*jjm
+             var(i2p) = var_tmp(ip)
+          ENDDO
+       ENDDO
+    ELSE
+       var(cindex(:)) = var_tmp(:)
+    ENDIF
 !---
   ELSE
@@ -1581 +1633 @@
   ENDIF
 !-
-  IF (check) WRITE(*,*) 'flinget_mat 3.1 : ',NF90_STRERROR (iret)
+  IF (l_dbg) WRITE(ipslout,*) 'flinget_mat 3.1 : ',NF90_STRERROR (iret)
 !--------------------------
 END  SUBROUTINE flinget_mat
@@ -1627 +1679 @@
 ! LOCAL
 !-
-  INTEGER :: iret, fid
-!-
-  LOGICAL :: check = .FALSE.
-!---------------------------------------------------------------------
-  IF (check) THEN
-    WRITE (*,*) 'flinget_scal in file with id ',fid_in
+  INTEGER :: iret, fid, vid
+  INTEGER :: attlen, attnum
+  INTEGER :: ndims, nb_atts
+  INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: dimids
+  LOGICAL :: var_exists
+!-
+  LOGICAL :: l_dbg
+  INTEGER :: lll
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+
+  IF (l_dbg) THEN
+    WRITE (ipslout,*) 'flinget_scal in file with id ',fid_in
   ENDIF
 !-
   fid = ncids(fid_in)
+  iret = NF90_INQUIRE_ATTRIBUTE(fid, NF90_GLOBAL, varname, len=attlen, attnum=attnum)
 !-
 ! 1.0 Reading a global attribute
 !-
-  iret = NF90_GET_ATT (fid, NF90_GLOBAL, varname, var)
+  IF ( iret == nf90_noerr ) THEN
+     !
+     ! This seems to be a Global attribute
+     !
+     iret = NF90_GET_ATT (fid, NF90_GLOBAL, varname, var)
+  ELSE
+     !
+     ! If there was an error on the test for a global attribute it
+     ! is perhaps a scalar variable.
+     !
+     vid = -1
+     iret = NF90_INQ_VARID (fid, varname, vid)
+     !
+     IF ( (vid >= 0).AND.(iret == NF90_NOERR) ) THEN
+        iret = NF90_INQUIRE_VARIABLE (fid, vid, &
+             ndims=ndims, dimids=dimids, nAtts=nb_atts)
+        IF (ndims == 1) THEN
+           iret = NF90_INQUIRE_DIMENSION (fid, dimids(1), len=lll)
+        ENDIF
+
+        IF ( ((ndims == 0) .OR. ((ndims == 1).AND.(lll == 1))) .AND. (nb_atts >= 0) ) THEN
+           iret = NF90_GET_VAR(fid, vid, var)
+        ELSE
+           CALL histerr (3,'flinget_scal', &
+                'The variable has coordinates and thus is probably not a scalar.', &
+                'Check your netCDF file.', " ")
+        ENDIF
+     ENDIF
+     IF (l_dbg) THEN
+        WRITE(ipslout,*) "Reading a Scalar value for varibale ", varname," It has value ", var
+     ENDIF
+  ENDIF
+!-
 !---------------------------
 END  SUBROUTINE flinget_scal
@@ -1891 +1983 @@
       WRITE (*,*) 'Dimension Z size   : ',llm
     ELSE IF (    (INDEX(axname,'tstep') == 1) &
+             .OR.(INDEX(axname,'time') == 1) &
              .OR.(INDEX(axname,'time_counter') == 1)) THEN
 !---- For the time we certainly need to allow for other names

dynamico_lmdz/aquaplanet/IOIPSL/src/fliocom.f90

@@ -1 +1 @@
 MODULE fliocom
 !-
-!$Id: fliocom.f90 965 2010-04-07 08:38:54Z bellier $
+!$Id: fliocom.f90 2311 2014-08-04 13:52:44Z mafoipsl $
 !-
 ! This software is governed by the CeCILL license
@@ -11 +11 @@
 USE calendar,  ONLY : lock_calendar,ioget_calendar, &
  &                    ioconf_calendar,ju2ymds,ymds2ju
-USE errioipsl, ONLY : ipslerr,ipsldbg
+USE errioipsl, ONLY : ipslerr,ipsldbg, ipslout
 USE stringop,  ONLY : strlowercase,str_xfw
 !-
@@ -49 +49 @@
 !!--------------------------------------------------------------------
   INTEGER,PARAMETER,PUBLIC :: &
- &  flio_max_files=100, flio_max_dims=10, flio_max_var_dims=5
+ &  flio_max_files=100, flio_max_dims=15, flio_max_var_dims=5
   INTEGER,PARAMETER,PUBLIC :: &
  &  flio_i = -1,        flio_r = -2,        flio_c =nf90_char, &
@@ -867 +867 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->fliocrfd - file name : ",TRIM(f_n)
+    WRITE(ipslout,*) "->fliocrfd - file name : ",TRIM(f_n)
   ENDIF
 !-
@@ -990 +990 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) '  fliocrfd, external model file-id : ',f_e
+    WRITE(ipslout,*) '  fliocrfd, external model file-id : ',f_e
   ENDIF
 !-
@@ -1040 +1040 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) '<-fliocrfd'
+    WRITE(ipslout,*) '<-fliocrfd'
   ENDIF
 !----------------------
@@ -1074 +1074 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->fliopstc"
+    WRITE(ipslout,*) "->fliopstc"
   ENDIF
 !-
@@ -1100 +1100 @@
 !---
     IF (l_dbg) THEN
-      WRITE(*,*) '  fliopstc : Define the Longitude axis'
+      WRITE(ipslout,*) '  fliopstc : Define the Longitude axis'
     ENDIF
 !---
@@ -1144 +1144 @@
 !---
     IF (l_dbg) THEN
-      WRITE(*,*) '  fliopstc : Define the Latitude axis'
+      WRITE(ipslout,*) '  fliopstc : Define the Latitude axis'
     ENDIF
 !---
@@ -1188 +1188 @@
 !---
     IF (l_dbg) THEN
-      WRITE(*,*) '  fliopstc : Define the Vertical axis'
+      WRITE(ipslout,*) '  fliopstc : Define the Vertical axis'
     ENDIF
 !---
@@ -1219 +1219 @@
 !---
     IF (l_dbg) THEN
-      WRITE(*,*) '  fliopstc : Define the Time axis'
+      WRITE(ipslout,*) '  fliopstc : Define the Time axis'
     ENDIF
 !---
@@ -1317 +1317 @@
   IF (PRESENT(x_axis).OR.PRESENT(x_axis_2d)) THEN
     IF (l_dbg) THEN
-      WRITE(*,*) '  fliopstc : Create the Longitude axis'
+      WRITE(ipslout,*) '  fliopstc : Create the Longitude axis'
     ENDIF
     IF (PRESENT(x_axis)) THEN
@@ -1330 +1330 @@
   IF (PRESENT(y_axis).OR.PRESENT(y_axis_2d)) THEN
     IF (l_dbg) THEN
-      WRITE(*,*) '  fliopstc : Create the Latitude axis'
+      WRITE(ipslout,*) '  fliopstc : Create the Latitude axis'
     ENDIF
     IF (PRESENT(y_axis)) THEN
@@ -1343 +1343 @@
   IF (PRESENT(z_axis)) THEN
     IF (l_dbg) THEN
-      WRITE(*,*) '  fliopstc : Create the Vertical axis'
+      WRITE(ipslout,*) '  fliopstc : Create the Vertical axis'
     ENDIF
     i_rc = NF90_PUT_VAR(f_e,levid,z_axis(:))
@@ -1352 +1352 @@
   IF (PRESENT(t_axis)) THEN
     IF (l_dbg) THEN
-      WRITE(*,*) '  fliopstc : Create the Time axis'
+      WRITE(ipslout,*) '  fliopstc : Create the Time axis'
     ENDIF
     i_rc = NF90_PUT_VAR(f_e,timeid,REAL(t_axis(:)))
@@ -1362 +1362 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-fliopstc"
+    WRITE(ipslout,*) "<-fliopstc"
   ENDIF
 !----------------------
@@ -1428 +1428 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->fliodefv ",TRIM(v_n)," ",n_d,"D"
+    WRITE(ipslout,*) "->fliodefv ",TRIM(v_n)," ",n_d,"D"
   ENDIF
 !-
@@ -1567 +1567 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-fliodefv"
+    WRITE(ipslout,*) "<-fliodefv"
   ENDIF
 !----------------------
@@ -2048 +2048 @@
     ELSE IF (PRESENT(r_85)) THEN; cvr_d = "R8 5D";
     ENDIF
-    WRITE(*,*) "->flioputv ",TRIM(v_n)," ",TRIM(cvr_d)
+    WRITE(ipslout,*) "->flioputv ",TRIM(v_n)," ",TRIM(cvr_d)
   ENDIF
 !-
@@ -2131 +2131 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-flioputv"
+    WRITE(ipslout,*) "<-flioputv"
   ENDIF
 !----------------------
@@ -2238 +2238 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->flioputa ",TRIM(v_n)," ",TRIM(a_n)
+    WRITE(ipslout,*) "->flioputa ",TRIM(v_n)," ",TRIM(a_n)
   ENDIF
 !-
@@ -2270 +2270 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-flioputa"
+    WRITE(ipslout,*) "<-flioputa"
   ENDIF
 !----------------------
@@ -2291 +2291 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) '->flioopfd, file name : ',TRIM(f_n)
+    WRITE(ipslout,*) '->flioopfd, file name : ',TRIM(f_n)
   ENDIF
 !-
@@ -2325 +2325 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) '  flioopfd, model file-id : ',f_e
+    WRITE(ipslout,*) '  flioopfd, model file-id : ',f_e
   ENDIF
 !-
@@ -2350 +2350 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,'("   flioopfd - dimensions :",/,(5(1X,I10),:))') &
+    WRITE(ipslout,'("   flioopfd - dimensions :",/,(5(1X,I10),:))') &
  &    nw_dl(:,f_i)
-    WRITE(*,*) "<-flioopfd"
+    WRITE(ipslout,*) "<-flioopfd"
   ENDIF
 !----------------------
@@ -2373 +2373 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->flioinqf"
+    WRITE(ipslout,*) "->flioinqf"
   ENDIF
 !-
@@ -2418 +2418 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-flioinqf"
+    WRITE(ipslout,*) "<-flioinqf"
   ENDIF
 !----------------------
@@ -2445 +2445 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->flioinqn"
+    WRITE(ipslout,*) "->flioinqn"
   ENDIF
 !-
@@ -2622 +2622 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-flioinqn"
+    WRITE(ipslout,*) "<-flioinqn"
   ENDIF
 !----------------------
@@ -2662 +2662 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->fliogstc"
+    WRITE(ipslout,*) "->fliogstc"
   ENDIF
 !-
@@ -2702 +2702 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,'("   fliogstc - dimensions :",/,(5(1X,I10),:))') &
+    WRITE(ipslout,'("   fliogstc - dimensions :",/,(5(1X,I10),:))') &
  &    m_x,m_y,m_z,m_t
   ENDIF
@@ -2932 +2932 @@
 !---
     IF (l_dbg) THEN
-      WRITE(*,*) '  fliogstc - get time details'
+      WRITE(ipslout,*) '  fliogstc - get time details'
     ENDIF
 !---
@@ -2977 +2977 @@
 !---
     IF (l_dbg) THEN
-      WRITE(*,*) '  fliogstc - first time : ',t_axis(1:1)
+      WRITE(ipslout,*) '  fliogstc - first time : ',t_axis(1:1)
     ENDIF
   ENDIF
@@ -3015 +3015 @@
     CALL lock_calendar (new_status=l_tmp)
     IF (l_dbg) THEN
-      WRITE(*,*) '  fliogstc - time_type : '
-      WRITE(*,*) it_t
-      WRITE(*,*) '  fliogstc - year month day second t_init : '
-      WRITE(*,*) j_yy,j_mo,j_dd,r_ss,t_init
+      WRITE(ipslout,*) '  fliogstc - time_type : '
+      WRITE(ipslout,*) it_t
+      WRITE(ipslout,*) '  fliogstc - year month day second t_init : '
+      WRITE(ipslout,*) j_yy,j_mo,j_dd,r_ss,t_init
     ENDIF
   ENDIF
@@ -3080 +3080 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-fliogstc"
+    WRITE(ipslout,*) "<-fliogstc"
   ENDIF
 !----------------------
@@ -3108 +3108 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->flioinqv ",TRIM(v_n)
+    WRITE(ipslout,*) "->flioinqv ",TRIM(v_n)
   ENDIF
 !-
@@ -3221 +3221 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-flioinqv"
+    WRITE(ipslout,*) "<-flioinqv"
   ENDIF
 !----------------------
@@ -3702 +3702 @@
     ELSE IF (PRESENT(r_85)) THEN; cvr_d = "R8 5D";
     ENDIF
-    WRITE(*,*) "->fliogetv ",TRIM(v_n)," ",TRIM(cvr_d)
+    WRITE(ipslout,*) "->fliogetv ",TRIM(v_n)," ",TRIM(cvr_d)
   ENDIF
 !-
@@ -3785 +3785 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-fliogetv"
+    WRITE(ipslout,*) "<-fliogetv"
   ENDIF
 !----------------------
@@ -3806 +3806 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->flioinqa ",TRIM(v_n),"-",TRIM(a_n)
+    WRITE(ipslout,*) "->flioinqa ",TRIM(v_n),"-",TRIM(a_n)
   ENDIF
 !-
@@ -3836 +3836 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-flioinqa"
+    WRITE(ipslout,*) "<-flioinqa"
   ENDIF
 !----------------------
@@ -3948 +3948 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->fliogeta ",TRIM(v_n)," ",TRIM(a_n)
+    WRITE(ipslout,*) "->fliogeta ",TRIM(v_n)," ",TRIM(a_n)
   ENDIF
 !-
@@ -4012 +4012 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-fliogeta"
+    WRITE(ipslout,*) "<-fliogeta"
   ENDIF
 !----------------------
@@ -4031 +4031 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) &
+    WRITE(ipslout,*) &
  &    "->fliorenv ",TRIM(v_o_n),"->",TRIM(v_n_n)
   ENDIF
@@ -4052 +4052 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-fliorenv"
+    WRITE(ipslout,*) "<-fliorenv"
   ENDIF
 !----------------------
@@ -4071 +4071 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) &
+    WRITE(ipslout,*) &
  &    "->fliorena ",TRIM(v_n),"-",TRIM(a_o_n),"->",TRIM(a_n_n)
   ENDIF
@@ -4102 +4102 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-fliorena"
+    WRITE(ipslout,*) "<-fliorena"
   ENDIF
 !----------------------
@@ -4121 +4121 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->fliodela ",TRIM(v_n),"-",TRIM(a_n)
+    WRITE(ipslout,*) "->fliodela ",TRIM(v_n),"-",TRIM(a_n)
   ENDIF
 !-
@@ -4150 +4150 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-fliodela"
+    WRITE(ipslout,*) "<-fliodela"
   ENDIF
 !----------------------
@@ -4169 +4169 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->fliocpya - file",f_i_i,"-",TRIM(v_n_i),"-",TRIM(a_n)
-    WRITE(*,*) "  copied to file ",f_i_o,"-",TRIM(v_n_o)
+    WRITE(ipslout,*) "->fliocpya - file",f_i_i,"-",TRIM(v_n_i),"-",TRIM(a_n)
+    WRITE(ipslout,*) "  copied to file ",f_i_o,"-",TRIM(v_n_o)
   ENDIF
 !-
@@ -4216 +4216 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-fliocpya"
+    WRITE(ipslout,*) "<-fliocpya"
   ENDIF
 !----------------------
@@ -4238 +4238 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->flioqstc ",TRIM(c_type)
+    WRITE(ipslout,*) "->flioqstc ",TRIM(c_type)
   ENDIF
 !-
@@ -4260 +4260 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-flioqstc"
+    WRITE(ipslout,*) "<-flioqstc"
   ENDIF
 !----------------------
@@ -4276 +4276 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->fliosync"
+    WRITE(ipslout,*) "->fliosync"
   ENDIF
 !-
@@ -4302 +4302 @@
     IF (f_e > 0) THEN
       IF (l_dbg) THEN
-        WRITE(*,*) '  fliosync - synchronising file number ',i_f
+        WRITE(ipslout,*) '  fliosync - synchronising file number ',i_f
       ENDIF
       i_rc = NF90_SYNC(f_e)
@@ -4312 +4312 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-fliosync"
+    WRITE(ipslout,*) "<-fliosync"
   ENDIF
 !----------------------
@@ -4328 +4328 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->flioclo"
+    WRITE(ipslout,*) "->flioclo"
   ENDIF
 !-
@@ -4350 +4350 @@
     IF (f_e > 0) THEN
       IF (l_dbg) THEN
-        WRITE(*,*) '  flioclo - closing file number ',i_f
+        WRITE(ipslout,*) '  flioclo - closing file number ',i_f
       ENDIF
       i_rc = NF90_CLOSE(f_e)
+!- error case added : explicit the message and stop with a fatal error
+      IF (i_rc /= NF90_NOERR) THEN
+        CALL ipslerr (3,'flioclo', &
+ &       'Could not close file','Try again and contact your local administrator ', &
+ &       TRIM(NF90_STRERROR(i_rc))//' (Netcdf)')
+      ENDIF
       nw_id(i_f) = -1
     ELSE IF (PRESENT(f_i)) THEN
@@ -4361 +4367 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-flioclo"
+    WRITE(ipslout,*) "<-flioclo"
   ENDIF
 !---------------------
@@ -4392 +4398 @@
   ENDIF
 !-
-  WRITE (*,*) "---"
-  WRITE (*,*) "--- File '",TRIM(f_n),"'"
-  WRITE (*,*) "---"
+  WRITE (ipslout,*) "---"
+  WRITE (ipslout,*) "--- File '",TRIM(f_n),"'"
+  WRITE (ipslout,*) "---"
 !-
   CALL flio_inf &
@@ -4401 +4407 @@
  &       nn_idm=n_idim,nn_ldm=n_ldim,cc_ndm=c_ndim,nn_aid=n_ai)
 !-
-  WRITE (*,*) 'External model identifier   : ',f_e
-  WRITE (*,*) 'Number of dimensions        : ',n_dims
-  WRITE (*,*) 'Number of variables         : ',n_vars
-  WRITE (*,*) 'ID unlimited                : ',i_unlm
-!-
-  WRITE (*,*) "---"
-  WRITE (*,*) 'Presumed axis dimensions identifiers :'
+  WRITE (ipslout,*) 'External model identifier   : ',f_e
+  WRITE (ipslout,*) 'Number of dimensions        : ',n_dims
+  WRITE (ipslout,*) 'Number of variables         : ',n_vars
+  WRITE (ipslout,*) 'ID unlimited                : ',i_unlm
+!-
+  WRITE (ipslout,*) "---"
+  WRITE (ipslout,*) 'Presumed axis dimensions identifiers :'
   IF (n_ai(k_lon) > 0) THEN
-    WRITE (*,*) 'x axis : ',n_ai(k_lon)
+    WRITE (ipslout,*) 'x axis : ',n_ai(k_lon)
   ELSE
-    WRITE (*,*) 'x axis : NONE'
+    WRITE (ipslout,*) 'x axis : NONE'
   ENDIF
   IF (n_ai(k_lat) > 0) THEN
-    WRITE (*,*) 'y axis : ',n_ai(k_lat)
+    WRITE (ipslout,*) 'y axis : ',n_ai(k_lat)
   ELSE
-    WRITE (*,*) 'y axis : NONE'
+    WRITE (ipslout,*) 'y axis : NONE'
   ENDIF
   IF (n_ai(k_lev) > 0) THEN
-    WRITE (*,*) 'z axis : ',n_ai(k_lev)
+    WRITE (ipslout,*) 'z axis : ',n_ai(k_lev)
   ELSE
-    WRITE (*,*) 'z axis : NONE'
+    WRITE (ipslout,*) 'z axis : NONE'
   ENDIF
   IF (n_ai(k_tim) > 0) THEN
-    WRITE (*,*) 't axis : ',n_ai(k_tim)
+    WRITE (ipslout,*) 't axis : ',n_ai(k_tim)
   ELSE
-    WRITE (*,*) 't axis : NONE'
-  ENDIF
-!-
-  WRITE (*,*) "---"
-  WRITE (*,*) 'Number of global attributes : ',n_atts
+    WRITE (ipslout,*) 't axis : NONE'
+  ENDIF
+!-
+  WRITE (ipslout,*) "---"
+  WRITE (ipslout,*) 'Number of global attributes : ',n_atts
   DO k_n=1,n_atts
     i_rc = NF90_INQ_ATTNAME(f_e,NF90_GLOBAL,k_n,c_name)
@@ -4440 +4446 @@
         ALLOCATE(tma_i(l_ea))
         i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tma_i)
-        WRITE (*,'("    ",A," :",/,(5(1X,I10),:))') &
+        WRITE (ipslout,'("    ",A," :",/,(5(1X,I10),:))') &
  &        TRIM(c_name),tma_i(1:l_ea)
         DEALLOCATE(tma_i)
       ELSE
         i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tmp_i)
-        WRITE(*,*) '   ',TRIM(c_name),' : ',tmp_i
+        WRITE(ipslout,*) '   ',TRIM(c_name),' : ',tmp_i
       ENDIF
     ELSE IF ( (t_ea == NF90_REAL4).OR.(t_ea == NF90_REAL8) ) THEN
@@ -4451 +4457 @@
         ALLOCATE(tma_r(l_ea))
         i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tma_r)
-        WRITE (*,'("    ",A," :",/,(5(1X,1PE11.3),:))') &
+        WRITE (ipslout,'("    ",A," :",/,(5(1X,1PE11.3),:))') &
  &        TRIM(c_name),tma_r(1:l_ea)
         DEALLOCATE(tma_r)
       ELSE
         i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tmp_r)
-        WRITE(*,*) '   ',TRIM(c_name),' : ',tmp_r
+        WRITE(ipslout,*) '   ',TRIM(c_name),' : ',tmp_r
       ENDIF
     ELSE
       tmp_c = ''
       i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tmp_c)
-      WRITE(*,*) '   ',TRIM(c_name),' : "',TRIM(tmp_c),'"'
+      WRITE(ipslout,*) '   ',TRIM(c_name),' : "',TRIM(tmp_c),'"'
     ENDIF
   ENDDO
@@ -4467 +4473 @@
   DO i_n=1,nb_fd_mx
     IF (n_idim(i_n) > 0) THEN
-      WRITE (*,*) "---"
-      WRITE (*,*) 'Dimension id   : ',n_idim(i_n)
-      WRITE (*,*) 'Dimension name : ',TRIM(c_ndim(i_n))
-      WRITE (*,*) 'Dimension size : ',n_ldim(i_n)
+      WRITE (ipslout,*) "---"
+      WRITE (ipslout,*) 'Dimension id   : ',n_idim(i_n)
+      WRITE (ipslout,*) 'Dimension name : ',TRIM(c_ndim(i_n))
+      WRITE (ipslout,*) 'Dimension size : ',n_ldim(i_n)
     ENDIF
   ENDDO
@@ -4477 +4483 @@
     i_rc = NF90_INQUIRE_VARIABLE(f_e,i_n, &
  &           name=c_name,ndims=n_dims,dimids=idimid,nAtts=n_atts)
-    WRITE (*,*) "---"
-    WRITE (*,*) "Variable name        : ",TRIM(c_name)
-    WRITE (*,*) "Variable identifier  : ",i_n
-    WRITE (*,*) "Number of dimensions : ",n_dims
+    WRITE (ipslout,*) "---"
+    WRITE (ipslout,*) "Variable name        : ",TRIM(c_name)
+    WRITE (ipslout,*) "Variable identifier  : ",i_n
+    WRITE (ipslout,*) "Number of dimensions : ",n_dims
     IF (n_dims > 0) THEN
-      WRITE (*,*) "Dimensions ID's      : ",idimid(1:n_dims)
-    ENDIF
-    WRITE (*,*) "Number of attributes : ",n_atts
+      WRITE (ipslout,*) "Dimensions ID's      : ",idimid(1:n_dims)
+    ENDIF
+    WRITE (ipslout,*) "Number of attributes : ",n_atts
     DO k_n=1,n_atts
       i_rc = NF90_INQ_ATTNAME(f_e,i_n,k_n,c_name)
@@ -4494 +4500 @@
           ALLOCATE(tma_i(l_ea))
           i_rc = NF90_GET_ATT(f_e,i_n,c_name,tma_i)
-          WRITE (*,'("    ",A," :",/,(5(1X,I10),:))') &
+          WRITE (ipslout,'("    ",A," :",/,(5(1X,I10),:))') &
  &              TRIM(c_name),tma_i(1:l_ea)
           DEALLOCATE(tma_i)
         ELSE
           i_rc = NF90_GET_ATT(f_e,i_n,c_name,tmp_i)
-          WRITE(*,*) '   ',TRIM(c_name),' : ',tmp_i
+          WRITE(ipslout,*) '   ',TRIM(c_name),' : ',tmp_i
         ENDIF
       ELSE IF ( (t_ea == NF90_REAL4).OR.(t_ea == NF90_REAL8) ) THEN
@@ -4505 +4511 @@
           ALLOCATE(tma_r(l_ea))
           i_rc = NF90_GET_ATT(f_e,i_n,c_name,tma_r)
-          WRITE (*,'("    ",A," :",/,(5(1X,1PE11.3),:))') &
+          WRITE (ipslout,'("    ",A," :",/,(5(1X,1PE11.3),:))') &
  &          TRIM(c_name),tma_r(1:l_ea)
           DEALLOCATE(tma_r)
         ELSE
           i_rc = NF90_GET_ATT(f_e,i_n,c_name,tmp_r)
-          WRITE(*,*) '   ',TRIM(c_name),' : ',tmp_r
+          WRITE(ipslout,*) '   ',TRIM(c_name),' : ',tmp_r
         ENDIF
       ELSE
         tmp_c = ''
         i_rc = NF90_GET_ATT(f_e,i_n,c_name,tmp_c)
-        WRITE(*,*) '   ',TRIM(c_name),' : "',TRIM(tmp_c),'"'
+        WRITE(ipslout,*) '   ',TRIM(c_name),' : "',TRIM(tmp_c),'"'
       ENDIF
     ENDDO
   ENDDO
-  WRITE (*,*) "---"
+  WRITE (ipslout,*) "---"
 !-
   i_rc = NF90_CLOSE(f_e)
@@ -4937 +4943 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->flio_inf"
+    WRITE(ipslout,*) "->flio_inf"
   ENDIF
 !-
@@ -4960 +4966 @@
 !---
     IF (l_dbg) THEN
-      WRITE(*,*) "  flio_inf ",kv,ml," ",TRIM(f_d_n)
+      WRITE(ipslout,*) "  flio_inf ",kv,ml," ",TRIM(f_d_n)
     ENDIF
 !---
@@ -5005 +5011 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-flio_inf"
+    WRITE(ipslout,*) "<-flio_inf"
   ENDIF
 !----------------------

dynamico_lmdz/aquaplanet/IOIPSL/src/getincom.f90

@@ -1 +1 @@
 MODULE getincom
 !-
-!$Id: getincom.f90 963 2010-03-31 15:26:11Z bellier $
+!$Id: getincom.f90 1574 2011-11-10 08:21:23Z mmaipsl $
 !-
 ! This software is governed by the CeCILL license
 ! See IOIPSL/IOIPSL_License_CeCILL.txt
 !---------------------------------------------------------------------
-USE errioipsl, ONLY : ipslerr
+USE errioipsl, ONLY : ipslerr,ipsldbg,ipslout
 USE stringop, &
  &   ONLY : nocomma,cmpblank,strlowercase
@@ -13 +13 @@
 !-
 PRIVATE
-PUBLIC :: getin_name, getin, getin_dump
+PUBLIC :: getin_name, getin, getin_dump, getin_dump_para
 !-
 !!--------------------------------------------------------------------
@@ -35 +35 @@
 !! and if not we get it from the definition file.
 !!
-!! SUBROUTINE getin (target,ret_val)
+!! SUBROUTINE getin (targetname,ret_val)
 !!
 !! INPUT
 !!
-!! (C) target : Name of the variable
+!! (C) targetname : Name of the variable
 !!
 !! OUTPUT
@@ -67 +67 @@
 !!--------------------------------------------------------------------
 !-
+!!------------------------------------------------------------------------
+!! Parallel version of getin_dump : user must give a fileprefix and a rank.
+!! It may be usefull to verify that only the root proc is reading the input
+!! def files.
+!!
+!!  SUBROUTINE getin_dump_para (fileprefix,rank)
+!!
+!! INPUT argument
+!!
+!! (C) fileprefix : allows the user to change the name of the file
+!!                  in which the data will be archived
+!! (I) rank : the rank of the parallel process (only 0-999 files will be created)
+!!--------------------------------------------------------------------
+!-
   INTEGER,PARAMETER :: max_files=100
   CHARACTER(LEN=100),DIMENSION(max_files),SAVE :: filelist
@@ -98 +112 @@
 ! keystatus = 2 : Default value is used
 ! keystatus = 3 : Some vector elements were taken from default
+  INTEGER,PARAMETER :: nondefault=1, default=2, vectornondefault=3
 !-
 ! keytype definition
@@ -150 +165 @@
 !=== INTEGER INTERFACE
 !-
-SUBROUTINE getinis (target,ret_val)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=*) :: target
+SUBROUTINE getinis (targetname,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: targetname
   INTEGER :: ret_val
 !-
   INTEGER,DIMENSION(1) :: tmp_ret_val
-  INTEGER :: pos,status=0,fileorig
-!---------------------------------------------------------------------
-!-
-! Do we have this target in our database ?
-!-
-  CALL get_findkey (1,target,pos)
+  INTEGER :: pos,status=0,fileorig, size_of_in
+!---------------------------------------------------------------------
+!-
+! Do we have this targetname in our database ?
+!-
+  CALL get_findkey (1,targetname,pos)
 !-
   tmp_ret_val(1) = ret_val
+  size_of_in = SIZE(tmp_ret_val)
+  
 !-
   IF (pos < 0) THEN
 !-- Get the information out of the file
-    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+    CALL get_fil (targetname,status,fileorig,size_of_in,i_val=tmp_ret_val)
 !-- Put the data into the database
     CALL get_wdb &
- &   (target,status,fileorig,1,i_val=tmp_ret_val)
+ &   (targetname,status,fileorig,1,i_val=tmp_ret_val)
   ELSE
 !-- Get the value out of the database
-    CALL get_rdb (pos,1,target,i_val=tmp_ret_val)
+    CALL get_rdb (pos,1,targetname,i_val=tmp_ret_val)
   ENDIF
   ret_val = tmp_ret_val(1)
@@ -181 +198 @@
 END SUBROUTINE getinis
 !===
-SUBROUTINE getini1d (target,ret_val)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=*) :: target
+SUBROUTINE getini1d (targetname,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: targetname
   INTEGER,DIMENSION(:) :: ret_val
 !-
@@ -193 +210 @@
 !---------------------------------------------------------------------
 !-
-! Do we have this target in our database ?
-!-
-  CALL get_findkey (1,target,pos)
+! Do we have this targetname in our database ?
+!-
+  CALL get_findkey (1,targetname,pos)
 !-
   size_of_in = SIZE(ret_val)
@@ -209 +226 @@
   IF (pos < 0) THEN
 !-- Get the information out of the file
-    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+    CALL get_fil (targetname,status,fileorig,size_of_in,i_val=tmp_ret_val)
 !-- Put the data into the database
     CALL get_wdb &
- &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+ &   (targetname,status,fileorig,size_of_in,i_val=tmp_ret_val)
   ELSE
 !-- Get the value out of the database
-    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+    CALL get_rdb (pos,size_of_in,targetname,i_val=tmp_ret_val)
   ENDIF
   ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
@@ -221 +238 @@
 END SUBROUTINE getini1d
 !===
-SUBROUTINE getini2d (target,ret_val)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=*) :: target
+SUBROUTINE getini2d (targetname,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: targetname
   INTEGER,DIMENSION(:,:) :: ret_val
 !-
@@ -234 +251 @@
 !---------------------------------------------------------------------
 !-
-! Do we have this target in our database ?
-!-
-  CALL get_findkey (1,target,pos)
+! Do we have this targetname in our database ?
+!-
+  CALL get_findkey (1,targetname,pos)
 !-
   size_of_in = SIZE(ret_val)
@@ -259 +276 @@
   IF (pos < 0) THEN
 !-- Get the information out of the file
-    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+    CALL get_fil (targetname,status,fileorig,size_of_in,i_val=tmp_ret_val)
 !-- Put the data into the database
     CALL get_wdb &
- &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+ &   (targetname,status,fileorig,size_of_in,i_val=tmp_ret_val)
   ELSE
 !-- Get the value out of the database
-    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+    CALL get_rdb (pos,size_of_in,targetname,i_val=tmp_ret_val)
   ENDIF
 !-
@@ -280 +297 @@
 !=== REAL INTERFACE
 !-
-SUBROUTINE getinrs (target,ret_val)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=*) :: target
+SUBROUTINE getinrs (targetname,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: targetname
   REAL :: ret_val
 !-
   REAL,DIMENSION(1) :: tmp_ret_val
-  INTEGER :: pos,status=0,fileorig
-!---------------------------------------------------------------------
-!-
-! Do we have this target in our database ?
-!-
-  CALL get_findkey (1,target,pos)
+  INTEGER :: pos,status=0,fileorig, size_of_in
+!---------------------------------------------------------------------
+!-
+! Do we have this targetname in our database ?
+!-
+  CALL get_findkey (1,targetname,pos)
 !-
   tmp_ret_val(1) = ret_val
+  size_of_in = SIZE(tmp_ret_val)
 !-
   IF (pos < 0) THEN
 !-- Get the information out of the file
-    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+    CALL get_fil (targetname,status,fileorig,size_of_in,r_val=tmp_ret_val)
 !-- Put the data into the database
     CALL get_wdb &
- &   (target,status,fileorig,1,r_val=tmp_ret_val)
+ &   (targetname,status,fileorig,1,r_val=tmp_ret_val)
   ELSE
 !-- Get the value out of the database
-    CALL get_rdb (pos,1,target,r_val=tmp_ret_val)
+    CALL get_rdb (pos,1,targetname,r_val=tmp_ret_val)
   ENDIF
   ret_val = tmp_ret_val(1)
@@ -311 +329 @@
 END SUBROUTINE getinrs
 !===
-SUBROUTINE getinr1d (target,ret_val)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=*) :: target
+SUBROUTINE getinr1d (targetname,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: targetname
   REAL,DIMENSION(:) :: ret_val
 !-
@@ -323 +341 @@
 !---------------------------------------------------------------------
 !-
-! Do we have this target in our database ?
-!-
-  CALL get_findkey (1,target,pos)
+! Do we have this targetname in our database ?
+!-
+  CALL get_findkey (1,targetname,pos)
 !-
   size_of_in = SIZE(ret_val)
@@ -339 +357 @@
   IF (pos < 0) THEN
 !-- Get the information out of the file
-    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+    CALL get_fil (targetname,status,fileorig,size_of_in,r_val=tmp_ret_val)
 !-- Put the data into the database
     CALL get_wdb &
- &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+ &   (targetname,status,fileorig,size_of_in,r_val=tmp_ret_val)
   ELSE
 !-- Get the value out of the database
-    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+    CALL get_rdb (pos,size_of_in,targetname,r_val=tmp_ret_val)
   ENDIF
   ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
@@ -351 +369 @@
 END SUBROUTINE getinr1d
 !===
-SUBROUTINE getinr2d (target,ret_val)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=*) :: target
+SUBROUTINE getinr2d (targetname,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: targetname
   REAL,DIMENSION(:,:) :: ret_val
 !-
@@ -364 +382 @@
 !---------------------------------------------------------------------
 !-
-! Do we have this target in our database ?
-!-
-  CALL get_findkey (1,target,pos)
+! Do we have this targetname in our database ?
+!-
+  CALL get_findkey (1,targetname,pos)
 !-
   size_of_in = SIZE(ret_val)
@@ -389 +407 @@
   IF (pos < 0) THEN
 !-- Get the information out of the file
-    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+    CALL get_fil (targetname,status,fileorig,size_of_in,r_val=tmp_ret_val)
 !-- Put the data into the database
     CALL get_wdb &
- &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+ &   (targetname,status,fileorig,size_of_in,r_val=tmp_ret_val)
   ELSE
 !-- Get the value out of the database
-    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+    CALL get_rdb (pos,size_of_in,targetname,r_val=tmp_ret_val)
   ENDIF
 !-
@@ -410 +428 @@
 !=== CHARACTER INTERFACE
 !-
-SUBROUTINE getincs (target,ret_val)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=*) :: target
+SUBROUTINE getincs (targetname,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: targetname
   CHARACTER(LEN=*) :: ret_val
 !-
   CHARACTER(LEN=100),DIMENSION(1) :: tmp_ret_val
-  INTEGER :: pos,status=0,fileorig
-!---------------------------------------------------------------------
-!-
-! Do we have this target in our database ?
-!-
-  CALL get_findkey (1,target,pos)
+  INTEGER :: pos,status=0,fileorig,size_of_in
+!---------------------------------------------------------------------
+!-
+! Do we have this targetname in our database ?
+!-
+  CALL get_findkey (1,targetname,pos)
 !-
   tmp_ret_val(1) = ret_val
+  size_of_in = SIZE(tmp_ret_val)
 !-
   IF (pos < 0) THEN
 !-- Get the information out of the file
-    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+    CALL get_fil (targetname,status,fileorig,size_of_in,c_val=tmp_ret_val)
 !-- Put the data into the database
     CALL get_wdb &
- &   (target,status,fileorig,1,c_val=tmp_ret_val)
+ &   (targetname,status,fileorig,1,c_val=tmp_ret_val)
   ELSE
 !-- Get the value out of the database
-    CALL get_rdb (pos,1,target,c_val=tmp_ret_val)
+    CALL get_rdb (pos,1,targetname,c_val=tmp_ret_val)
   ENDIF
   ret_val = tmp_ret_val(1)
@@ -441 +460 @@
 END SUBROUTINE getincs
 !===
-SUBROUTINE getinc1d (target,ret_val)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=*) :: target
+SUBROUTINE getinc1d (targetname,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: targetname
   CHARACTER(LEN=*),DIMENSION(:) :: ret_val
 !-
@@ -453 +472 @@
 !---------------------------------------------------------------------
 !-
-! Do we have this target in our database ?
-!-
-  CALL get_findkey (1,target,pos)
+! Do we have this targetname in our database ?
+!-
+  CALL get_findkey (1,targetname,pos)
 !-
   size_of_in = SIZE(ret_val)
@@ -469 +488 @@
   IF (pos < 0) THEN
 !-- Get the information out of the file
-    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+    CALL get_fil (targetname,status,fileorig,size_of_in,c_val=tmp_ret_val)
 !-- Put the data into the database
     CALL get_wdb &
- &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+ &   (targetname,status,fileorig,size_of_in,c_val=tmp_ret_val)
   ELSE
 !-- Get the value out of the database
-    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+    CALL get_rdb (pos,size_of_in,targetname,c_val=tmp_ret_val)
   ENDIF
   ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
@@ -481 +500 @@
 END SUBROUTINE getinc1d
 !===
-SUBROUTINE getinc2d (target,ret_val)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=*) :: target
+SUBROUTINE getinc2d (targetname,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: targetname
   CHARACTER(LEN=*),DIMENSION(:,:) :: ret_val
 !-
@@ -494 +513 @@
 !---------------------------------------------------------------------
 !-
-! Do we have this target in our database ?
-!-
-  CALL get_findkey (1,target,pos)
+! Do we have this targetname in our database ?
+!-
+  CALL get_findkey (1,targetname,pos)
 !-
   size_of_in = SIZE(ret_val)
@@ -519 +538 @@
   IF (pos < 0) THEN
 !-- Get the information out of the file
-    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+    CALL get_fil (targetname,status,fileorig,size_of_in,c_val=tmp_ret_val)
 !-- Put the data into the database
     CALL get_wdb &
- &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+ &   (targetname,status,fileorig,size_of_in,c_val=tmp_ret_val)
   ELSE
 !-- Get the value out of the database
-    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+    CALL get_rdb (pos,size_of_in,targetname,c_val=tmp_ret_val)
   ENDIF
 !-
@@ -540 +559 @@
 !=== LOGICAL INTERFACE
 !-
-SUBROUTINE getinls (target,ret_val)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=*) :: target
+SUBROUTINE getinls (targetname,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: targetname
   LOGICAL :: ret_val
 !-
   LOGICAL,DIMENSION(1) :: tmp_ret_val
-  INTEGER :: pos,status=0,fileorig
-!---------------------------------------------------------------------
-!-
-! Do we have this target in our database ?
-!-
-  CALL get_findkey (1,target,pos)
+  INTEGER :: pos,status=0,fileorig,size_of_in
+!---------------------------------------------------------------------
+!-
+! Do we have this targetname in our database ?
+!-
+  CALL get_findkey (1,targetname,pos)
 !-
   tmp_ret_val(1) = ret_val
+  size_of_in = SIZE(tmp_ret_val)
 !-
   IF (pos < 0) THEN
 !-- Get the information out of the file
-    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+    CALL get_fil (targetname,status,fileorig,size_of_in,l_val=tmp_ret_val)
 !-- Put the data into the database
     CALL get_wdb &
- &   (target,status,fileorig,1,l_val=tmp_ret_val)
+ &   (targetname,status,fileorig,1,l_val=tmp_ret_val)
   ELSE
 !-- Get the value out of the database
-    CALL get_rdb (pos,1,target,l_val=tmp_ret_val)
+    CALL get_rdb (pos,1,targetname,l_val=tmp_ret_val)
   ENDIF
   ret_val = tmp_ret_val(1)
@@ -571 +591 @@
 END SUBROUTINE getinls
 !===
-SUBROUTINE getinl1d (target,ret_val)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=*) :: target
+SUBROUTINE getinl1d (targetname,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: targetname
   LOGICAL,DIMENSION(:) :: ret_val
 !-
@@ -583 +603 @@
 !---------------------------------------------------------------------
 !-
-! Do we have this target in our database ?
-!-
-  CALL get_findkey (1,target,pos)
+! Do we have this targetname in our database ?
+!-
+  CALL get_findkey (1,targetname,pos)
 !-
   size_of_in = SIZE(ret_val)
@@ -599 +619 @@
   IF (pos < 0) THEN
 !-- Get the information out of the file
-    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+    CALL get_fil (targetname,status,fileorig,size_of_in,l_val=tmp_ret_val)
 !-- Put the data into the database
     CALL get_wdb &
- &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+ &   (targetname,status,fileorig,size_of_in,l_val=tmp_ret_val)
   ELSE
 !-- Get the value out of the database
-    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+    CALL get_rdb (pos,size_of_in,targetname,l_val=tmp_ret_val)
   ENDIF
   ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
@@ -611 +631 @@
 END SUBROUTINE getinl1d
 !===
-SUBROUTINE getinl2d (target,ret_val)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=*) :: target
+SUBROUTINE getinl2d (targetname,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: targetname
   LOGICAL,DIMENSION(:,:) :: ret_val
 !-
@@ -624 +644 @@
 !---------------------------------------------------------------------
 !-
-! Do we have this target in our database ?
-!-
-  CALL get_findkey (1,target,pos)
+! Do we have this targetname in our database ?
+!-
+  CALL get_findkey (1,targetname,pos)
 !-
   size_of_in = SIZE(ret_val)
@@ -649 +669 @@
   IF (pos < 0) THEN
 !-- Get the information out of the file
-    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+    CALL get_fil (targetname,status,fileorig,size_of_in,l_val=tmp_ret_val)
 !-- Put the data into the database
     CALL get_wdb &
- &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+ &   (targetname,status,fileorig,size_of_in,l_val=tmp_ret_val)
   ELSE
 !-- Get the value out of the database
-    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+    CALL get_rdb (pos,size_of_in,targetname,l_val=tmp_ret_val)
   ENDIF
 !-
@@ -670 +690 @@
 !=== Generic file/database INTERFACE
 !-
-SUBROUTINE get_fil (target,status,fileorig,i_val,r_val,c_val,l_val)
+SUBROUTINE get_fil (targetname,status,fileorig,nb_to_ret,i_val,r_val,c_val,l_val)
 !---------------------------------------------------------------------
 !- Subroutine that will extract from the file the values
-!- attributed to the keyword target
-!-
-!- (C) target    : target for which we will look in the file
+!- attributed to the keyword targetname
+!-
+!- (C) targetname    : target for which we will look in the file
 !- (I) status    : tells us from where we obtained the data
 !- (I) fileorig  : index of the file from which the key comes
+!- (I) nb_to_ret : size of output vector
 !- (I) i_val(:)  : INTEGER(nb_to_ret)   values
 !- (R) r_val(:)  : REAL(nb_to_ret)      values
@@ -685 +706 @@
   IMPLICIT NONE
 !-
-  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*) :: targetname
+  INTEGER,INTENT(IN) :: nb_to_ret
   INTEGER,INTENT(OUT) :: status,fileorig
   INTEGER,DIMENSION(:),OPTIONAL          :: i_val
@@ -692 +714 @@
   CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
 !-
-  INTEGER :: k_typ,nb_to_ret,it,pos,len_str,status_cnt,io_err
+  INTEGER :: k_typ,it,pos,len_str,status_cnt,io_err
   CHARACTER(LEN=n_d_fmt)  :: cnt
   CHARACTER(LEN=80) :: str_READ,str_READ_lower
@@ -702 +724 @@
   REAL    :: r_cmpval
   INTEGER :: ipos_tr,ipos_fl
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
 !---------------------------------------------------------------------
 !-
 ! Get the type of the argument
   CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
-  SELECT CASE (k_typ)
-  CASE(k_i)
-    nb_to_ret = SIZE(i_val)
-  CASE(k_r)
-    nb_to_ret = SIZE(r_val)
-  CASE(k_c)
-    nb_to_ret = SIZE(c_val)
-  CASE(k_l)
-    nb_to_ret = SIZE(l_val)
-  CASE DEFAULT
+  IF ( (k_typ.NE.k_i) .AND. (k_typ.NE.k_r) .AND. (k_typ.NE.k_c) .AND. (k_typ.NE.k_l) ) THEN
     CALL ipslerr (3,'get_fil', &
  &   'Internal error','Unknown type of data',' ')
-  END SELECT
+  ENDIF
 !-
 ! Read the file(s)
@@ -728 +744 @@
 !-
 ! See what we find in the files read
+!---
+!-- We dont know from which file the target could come.
+!-- Thus by default we attribute it to the first file :
+  fileorig = 1
+!-
   DO it=1,nb_to_ret
 !---
 !-- First try the target as it is
-    CALL get_findkey (2,target,pos)
+    CALL get_findkey (2,targetname,pos)
 !---
 !-- Another try
@@ -737 +758 @@
     IF (pos < 0) THEN
       WRITE(UNIT=cnt,FMT=c_i_fmt) it
-      CALL get_findkey (2,TRIM(target)//'__'//cnt,pos)
-    ENDIF
-!---
-!-- We dont know from which file the target could come.
-!-- Thus by default we attribute it to the first file :
-    fileorig = 1
+      CALL get_findkey (2,TRIM(targetname)//'__'//cnt,pos)
+    ENDIF
 !---
     IF (pos > 0) THEN
@@ -748 +765 @@
       found(it) = .TRUE.
       fileorig = fromfile(pos)
+      !
+      IF (l_dbg) THEN
+         WRITE(*,*) &
+              &      'getin_fil : read key ',targetname,' from file ',fileorig,' has type ',k_typ
+      ENDIF
 !-----
 !---- DECODE
@@ -754 +776 @@
       str_READ_lower = str_READ
       CALL strlowercase (str_READ_lower)
+      IF (l_dbg) THEN
+         WRITE(*,*) &
+              &      '            value    ',str_READ_lower
+      ENDIF
 !-----
       IF (    (TRIM(str_READ_lower) == 'def')     &
@@ -789 +815 @@
         IF (io_err /= 0) THEN
           CALL ipslerr (3,'get_fil', &
- &         'Target '//TRIM(target), &
+ &         'Target '//TRIM(targetname), &
  &         'is not of '//TRIM(c_vtyp)//' type',' ')
         ENDIF
@@ -801 +827 @@
           IF (compline(pos) /= nb_to_ret) THEN
             CALL ipslerr (2,'get_fil', &
- &           'For key '//TRIM(target)//' we have a compressed field', &
+ &           'For key '//TRIM(targetname)//' we have a compressed field', &
  &           'which does not have the right size.', &
  &           'We will try to fix that.')
@@ -828 +854 @@
             i_val(it) = i_cmpval
           ELSE IF (k_typ == k_r) THEN
+            r_val(it) = r_cmpval
           ENDIF
           found(it) = .TRUE.
@@ -837 +864 @@
 ! Now we set the status for what we found
   IF (def_beha) THEN
-    status = 2
-    WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(target)
+    status = default
+    CALL ipslerr (1,'USING DEFAULT BEHAVIOUR FOR', &
+ &   TRIM(targetname),' ',' ')
+    WRITE(ipslout,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(targetname)
   ELSE
     status_cnt = 0
@@ -845 +874 @@
         status_cnt = status_cnt+1
         IF      (status_cnt <= max_msgs) THEN
-          WRITE (UNIT=*,FMT='(" USING DEFAULTS : ",A)', &
- &               ADVANCE='NO') TRIM(target)
+          WRITE (UNIT=ipslout,FMT='(" USING DEFAULTS : ",A)', &
+ &               ADVANCE='NO') TRIM(targetname)
           IF (nb_to_ret > 1) THEN
-            WRITE (UNIT=*,FMT='("__")',ADVANCE='NO')
-            WRITE (UNIT=*,FMT=c_i_fmt,ADVANCE='NO') it
+            WRITE (UNIT=ipslout,FMT='("__")',ADVANCE='NO')
+            WRITE (UNIT=ipslout,FMT=c_i_fmt,ADVANCE='NO') it
           ENDIF
           SELECT CASE (k_typ)
           CASE(k_i)
-            WRITE (UNIT=*,FMT=*) "=",i_val(it)
+            WRITE (UNIT=ipslout,FMT=*) "=",i_val(it)
           CASE(k_r)
-            WRITE (UNIT=*,FMT=*) "=",r_val(it)
+            WRITE (UNIT=ipslout,FMT=*) "=",r_val(it)
           CASE(k_c)
-            WRITE (UNIT=*,FMT=*) "=",c_val(it)
+            WRITE (UNIT=ipslout,FMT=*) "=",c_val(it)
           CASE(k_l)
-            WRITE (UNIT=*,FMT=*) "=",l_val(it)
+            WRITE (UNIT=ipslout,FMT=*) "=",l_val(it)
           END SELECT
         ELSE IF (status_cnt == max_msgs+1) THEN
-          WRITE (UNIT=*,FMT='(" USING DEFAULTS ... ",A)')
+          WRITE (UNIT=ipslout,FMT='(" USING DEFAULTS ... ",A)')
         ENDIF
       ENDIF
@@ -868 +897 @@
 !---
     IF (status_cnt == 0) THEN
-      status = 1
+      status = nondefault
     ELSE IF (status_cnt == nb_to_ret) THEN
-      status = 2
+      status = default
     ELSE
-      status = 3
+      status = vectornondefault
     ENDIF
   ENDIF
@@ -880 +909 @@
 END SUBROUTINE get_fil
 !===
-SUBROUTINE get_rdb (pos,size_of_in,target,i_val,r_val,c_val,l_val)
+SUBROUTINE get_rdb (pos,size_of_in,targetname,i_val,r_val,c_val,l_val)
 !---------------------------------------------------------------------
 !- Read the required variable in the database
@@ -887 +916 @@
 !-
   INTEGER :: pos,size_of_in
-  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*) :: targetname
   INTEGER,DIMENSION(:),OPTIONAL          :: i_val
   REAL,DIMENSION(:),OPTIONAL             :: r_val
@@ -907 +936 @@
   IF (key_tab(pos)%keytype /= k_typ) THEN
     CALL ipslerr (3,'get_rdb', &
- &   'Wrong data type for keyword '//TRIM(target), &
+ &   'Wrong data type for keyword '//TRIM(targetname), &
  &   '(NOT '//TRIM(c_vtyp)//')',' ')
   ENDIF
@@ -915 +944 @@
  &      .OR.(key_tab(pos)%keymemlen /= 1) ) THEN
       CALL ipslerr (3,'get_rdb', &
- &     'Wrong compression length','for keyword '//TRIM(target),' ')
+ &     'Wrong compression length','for keyword '//TRIM(targetname),' ')
     ELSE
       SELECT CASE (k_typ)
@@ -927 +956 @@
     IF (key_tab(pos)%keymemlen /= size_of_in) THEN
       CALL ipslerr (3,'get_rdb', &
- &     'Wrong array length','for keyword '//TRIM(target),' ')
+ &     'Wrong array length','for keyword '//TRIM(targetname),' ')
     ELSE
       k_beg = key_tab(pos)%keymemstart
@@ -947 +976 @@
 !===
 SUBROUTINE get_wdb &
- &  (target,status,fileorig,size_of_in, &
+ &  (targetname,status,fileorig,size_of_in, &
  &   i_val,r_val,c_val,l_val)
 !---------------------------------------------------------------------
@@ -954 +983 @@
   IMPLICIT NONE
 !-
-  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*) :: targetname
   INTEGER :: status,fileorig,size_of_in
   INTEGER,DIMENSION(:),OPTIONAL          :: i_val
@@ -965 +994 @@
   INTEGER :: k_mempos,k_memsize,k_beg,k_end
   LOGICAL :: l_cmp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
 !---------------------------------------------------------------------
 !-
@@ -999 +1031 @@
 ! Fill out the items of the data base
   nb_keys = nb_keys+1
-  key_tab(nb_keys)%keystr = target(1:MIN(LEN_TRIM(target),l_n))
+  key_tab(nb_keys)%keystr = targetname(1:MIN(LEN_TRIM(targetname),l_n))
   key_tab(nb_keys)%keystatus = status
   key_tab(nb_keys)%keytype = k_typ
@@ -1011 +1043 @@
     key_tab(nb_keys)%keymemlen = size_of_in
   ENDIF
+  IF (l_dbg) THEN
+     WRITE(*,*) &
+ &     "get_wdb : nb_keys ",nb_keys," key_tab keystr   ",key_tab(nb_keys)%keystr,&
+ &                                       ",keystatus   ",key_tab(nb_keys)%keystatus,&
+ &                                       ",keytype     ",key_tab(nb_keys)%keytype,&
+ &                                       ",keycompress ",key_tab(nb_keys)%keycompress,&
+ &                                       ",keyfromfile ",key_tab(nb_keys)%keyfromfile,&
+ &                                       ",keymemstart ",key_tab(nb_keys)%keymemstart
+  ENDIF
+
 !-
 ! Before writing the actual size lets see if we have the space
@@ -1086 +1128 @@
 !-
   INTEGER :: eof,ptn,len_str,i,it,iund,io_err
-  LOGICAL :: check = .FALSE.
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
 !---------------------------------------------------------------------
   eof = 0
@@ -1092 +1136 @@
   nb_lastkey = 0
 !-
-  IF (check) THEN
-    WRITE(*,*) 'getin_readdef : Open file ',TRIM(filelist(current))
+  IF (l_dbg) THEN
+    WRITE(ipslout,*) 'getin_readdef : Open file ',TRIM(filelist(current))
   ENDIF
 !-
@@ -1133 +1177 @@
       CALL cmpblank (NEW_str)
       NEW_str  = TRIM(ADJUSTL(NEW_str))
-      IF (check) THEN
-        WRITE(*,*) &
+      IF (l_dbg) THEN
+        WRITE(ipslout,*) &
  &        '--> getin_readdef : ',TRIM(key_str),' :: ',TRIM(NEW_str)
       ENDIF
@@ -1171 +1215 @@
 !---- If we have an empty line then the keyword finishes
       nb_lastkey = 0
-      IF (check) THEN
-        WRITE(*,*) 'getin_readdef : Have found an emtpy line '
+      IF (l_dbg) THEN
+        WRITE(ipslout,*) 'getin_readdef : Have found an emtpy line '
       ENDIF
     ENDIF
@@ -1179 +1223 @@
   CLOSE(UNIT=22)
 !-
-  IF (check) THEN
+  IF (l_dbg) THEN
     OPEN (UNIT=22,file=TRIM(def_file)//'.test')
     DO i=1,nb_lines
@@ -1186 +1230 @@
     CLOSE(UNIT=22)
   ENDIF
+!-
+  IF (l_dbg) THEN
+     WRITE(ipslout,*) "nb_lines ",nb_lines,"nb_keys ",nb_keys
+     WRITE(ipslout,*) "fichier ",fichier(1:nb_lines)
+     WRITE(ipslout,*) "targetlist ",targetlist(1:nb_lines)
+     WRITE(ipslout,*) "fromfile ",fromfile(1:nb_lines)
+     WRITE(ipslout,*) "compline ",compline(1:nb_lines)
+     WRITE(ipslout,*) '<-getin_readdef'
+  ENDIF
 !---------------------------
 END SUBROUTINE getin_readdef
@@ -1202 +1255 @@
 !-
   INTEGER :: current,nb_lastkey
-  CHARACTER(LEN=*) :: key_str,NEW_str,last_key
+  CHARACTER(LEN=*) :: key_str,NEW_str
+  CHARACTER(LEN=*),INTENT(out) :: last_key
 !-
 ! LOCAL
@@ -1210 +1264 @@
   CHARACTER(LEN=n_d_fmt) :: cnt
   CHARACTER(LEN=10) :: c_fmt
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
 !---------------------------------------------------------------------
   len_str = LEN_TRIM(NEW_str)
@@ -1347 +1404 @@
         nbve = nbve+1
         WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
+        compline(nb_lines)=compline(nb_lines-1)
 !-
       ENDDO
@@ -1365 +1423 @@
 !-
   ENDIF
+
+  IF (l_dbg) THEN
+     WRITE(ipslout,*) "getin_decrypt ->",TRIM(NEW_str), " : "
+     WRITE(ipslout,*) "getin_decrypt ->", nb_lines,&
+          & SIZE(fichier), &
+          & SIZE(fromfile), &
+          & SIZE(filelist)
+     IF (nb_lines > 0) THEN
+        WRITE(ipslout,*) "getin_decrypt ->", &
+          & TRIM(fichier(nb_lines)), &
+          & fromfile(nb_lines), &
+          & TRIM(filelist(fromfile(nb_lines)))
+        WRITE(ipslout,*) "                compline : ",compline(nb_lines)
+        WRITE(ipslout,*) "                targetlist : ",TRIM(targetlist(nb_lines))
+     ENDIF
+     WRITE(ipslout,*) "                last_key : ",last_key
+  ENDIF
 !---------------------------
 END SUBROUTINE getin_decrypt
@@ -1391 +1466 @@
 !---
     IF (n_k > 0) THEN
-      WRITE(*,*) 'COUNT : ',n_k
-      WRITE(*,*) &
+      WRITE(ipslout,*) 'COUNT : ',n_k
+      WRITE(ipslout,*) &
  &  'getin_checkcohe : Found a problem on key ',TRIM(targetlist(line))
-      WRITE(*,*) &
+      WRITE(ipslout,*) &
  &  'getin_checkcohe : The following values were encoutered :'
-      WRITE(*,*) &
+      WRITE(ipslout,*) &
  &  '                ',TRIM(targetlist(line)),' == ',fichier(line)
-      WRITE(*,*) &
+      WRITE(ipslout,*) &
  &  '                ',TRIM(targetlist(k)),' == ',fichier(k)
-      WRITE(*,*) &
+      WRITE(ipslout,*) &
  &  'getin_checkcohe : We will keep only the last value'
+       CALL ipslerr (2,'getin_checkcohe','Found a problem on key ', &
+ &                     TRIM(targetlist(line)), fichier(line)//" "//fichier(k))
       targetlist(line) = ' '
     ENDIF
@@ -1416 +1493 @@
   INTEGER :: unit,eof,nb_lastkey
   CHARACTER(LEN=100) :: dummy
-  CHARACTER(LEN=100) :: out_string
+  CHARACTER(LEN=100),INTENT(out) :: out_string
   CHARACTER(LEN=1) :: first
 !---------------------------------------------------------------------
@@ -1780 +1857 @@
   CHARACTER(LEN=20) :: c_tmp
   CHARACTER(LEN=100) :: tmp_str,used_filename
-  LOGICAL :: check = .FALSE.
+  INTEGER :: io_err
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
 !---------------------------------------------------------------------
   IF (PRESENT(fileprefix)) THEN
@@ -1791 +1871 @@
 !---
     used_filename = TRIM(usedfileprefix)//'_'//TRIM(filelist(if))
-    IF (check) THEN
-      WRITE(*,*) &
- &      'GETIN_DUMP : opens file : ',TRIM(used_filename),' if = ',if
-      WRITE(*,*) 'GETIN_DUMP : NUMBER OF KEYS : ',nb_keys
-    ENDIF
-    OPEN (UNIT=22,FILE=used_filename)
+    IF (l_dbg) THEN
+      WRITE(ipslout,*) &
+ &      'getin_dump : opens file : ',TRIM(used_filename),' if = ',if
+      WRITE(ipslout,*) 'GETIN_DUMP : NUMBER OF KEYS : ',nb_keys
+    ENDIF
+    OPEN (UNIT=22,FILE=used_filename,iostat=io_err)
+    IF (io_err /= 0) THEN
+       CALL ipslerr (3,'getin_dump', &
+            &   'Could not open file :',TRIM(used_filename), &
+            &   '')
+    ENDIF
 !---
 !-- If this is the first file we need to add the list
@@ -1808 +1893 @@
       ENDDO
       WRITE(22,*) '# '
+      IF (l_dbg) THEN
+         WRITE(ipslout,*) '# '
+         WRITE(ipslout,*) '# This file is linked to the following files :'
+         WRITE(ipslout,*) '# '
+         DO iff=2,nbfiles
+            WRITE(ipslout,*) 'INCLUDEDEF = ',TRIM(filelist(iff))
+         ENDDO
+         WRITE(ipslout,*) '# '
+      ENDIF
     ENDIF
 !---
@@ -1818 +1912 @@
         WRITE(22,*) '#'
         SELECT CASE (key_tab(ikey)%keystatus)
-        CASE(1)
+        CASE(nondefault)
           WRITE(22,*) '# Values of ', &
  &          TRIM(key_tab(ikey)%keystr),' comes from ',TRIM(def_file)
-        CASE(2)
+        CASE(default)
           WRITE(22,*) '# Values of ', &
  &          TRIM(key_tab(ikey)%keystr),' are all defaults.'
-        CASE(3)
+        CASE(vectornondefault)
           WRITE(22,*) '# Values of ', &
  &          TRIM(key_tab(ikey)%keystr), &
@@ -1833 +1927 @@
         END SELECT
         WRITE(22,*) '#'
+        !-
+        IF (l_dbg) THEN
+           WRITE(ipslout,*) '#'
+           WRITE(ipslout,*) '# Status of key ', ikey, ' : ',&
+ &          TRIM(key_tab(ikey)%keystr),key_tab(ikey)%keystatus
+        ENDIF
 !-------
 !------ Write the values
@@ -1925 +2025 @@
 END SUBROUTINE getin_dump
 !===
+SUBROUTINE getin_dump_para (fileprefix,rank)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(*) :: fileprefix
+  INTEGER,INTENT(IN) :: rank
+!-
+  CHARACTER(LEN=80) :: usedfileprefix
+  LOGICAL :: l_dbg
+  INTEGER :: isize
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!---------------------------------------------------------------------
+  IF ( rank < 1000 ) THEN
+     isize=MIN(LEN_TRIM(fileprefix),75)
+     usedfileprefix = fileprefix(1:isize)
+     usedfileprefix((isize+1):(isize+1))='_'
+     WRITE(usedfileprefix((isize+2):(isize+5)),'(I4.4)') rank
+     IF (l_dbg) &
+          WRITE(ipslout,*) 'Dump getin to file ',usedfileprefix
+     CALL getin_dump(usedfileprefix)
+  ENDIF
+!------------------------
+END SUBROUTINE getin_dump_para
+
+!===
 SUBROUTINE get_qtyp (k_typ,c_vtyp,i_v,r_v,c_v,l_v)
 !---------------------------------------------------------------------

dynamico_lmdz/aquaplanet/IOIPSL/src/histcom.f90

@@ -1 +1 @@
 MODULE histcom
 !-
-!$Id: histcom.f90 1028 2010-05-20 15:17:30Z bellier $
+!$Id: histcom.f90 2350 2014-10-08 12:21:30Z acosce $
 !-
 ! This software is governed by the CeCILL license
@@ -9 +9 @@
 !-
   USE stringop, ONLY : nocomma,cmpblank,findpos,find_str,strlowercase
-  USE mathelp,  ONLY : mathop,moycum,buildop
+  USE mathelp,  ONLY : mathop,moycum,moycum_index,buildop
   USE fliocom,  ONLY : flio_dom_file,flio_dom_att
   USE calendar
-  USE errioipsl, ONLY : ipslerr,ipsldbg
+  USE errioipsl, ONLY : ipslerr,ipsldbg,ipslout
 !-
   IMPLICIT NONE
@@ -18 +18 @@
   PRIVATE
   PUBLIC :: histbeg,histdef,histhori,histvert,histend, &
- &          histwrite,histclo,histsync,ioconf_modname
+ &          histwrite,histclo,histsync,ioconf_modname, histglobal_attr
 !---------------------------------------------------------------------
 !- Some confusing vocabulary in this code !
@@ -74 +74 @@
 ! Fixed parameter
 !-
-  INTEGER,PARAMETER :: nb_files_max=20,nb_var_max=2000, &
+  INTEGER,PARAMETER :: nb_files_max=20,nb_var_max=1000, &
  &                     nb_hax_max=5,nb_zax_max=10,nbopp_max=10
   REAL,PARAMETER :: missing_val=nf90_fill_real
@@ -123 +123 @@
 !-NETCDF IDs for file
   INTEGER :: ncfid=-1
+!-Name of the file
+  CHARACTER(LEN=120) :: name
 !-Time variables
   INTEGER :: itau0=0
@@ -340 +342 @@
   ENDIF
 !-
-  IF (l_dbg) WRITE(*,*) c_nam//" 0.0"
+  IF (l_dbg) WRITE(ipslout,*) c_nam//" 0.0"
 !-
 ! Search for a free index
@@ -358 +360 @@
 ! 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 +368 @@
 ! 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 +385 @@
 ! 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 +427 @@
 ! 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 +438 @@
 ! 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
     W_F(idf)%dom_id_svg = domain_id
   ENDIF
+  W_F(idf)%name = TRIM(nc_name)
   W_F(idf)%ncfid = nfid
   IF ( (k_typ == 1).OR.(k_typ == 2) ) THEN
@@ -467 +470 @@
 !-----------------------
 END SUBROUTINE histb_all
+!===
+SUBROUTINE histglobal_attr &
+ & (idf,string_attr,glob_attr)
+!---------------------------------------------------------------------
+!- Definition of GLOBAL attribute for history files.
+!-
+!- INPUT
+!-
+!- idf     : The id of the file to which the grid should be added
+!- string_attr : name of the global attribute to be added
+!- glob_attr : global_attribute to be added
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf
+  CHARACTER(len=*),INTENT(IN) :: string_attr
+  CHARACTER(len=*),INTENT(IN) :: glob_attr
+
+  INTEGER :: iret,nfid
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+
+  nfid = W_F(idf)%ncfid
+  IF (l_dbg) WRITE(ipslout,*) "New global attribute : ",glob_attr
+  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,string_attr,glob_attr)
+!-----------------------
+END SUBROUTINE histglobal_attr
 !===
 SUBROUTINE histh_reg1d &
@@ -612 +643 @@
 ! 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 +702 @@
 ! 2.0 Longitude
 !-
-  IF (l_dbg) WRITE(*,*) c_nam//" 2.0"
+  IF (l_dbg) WRITE(ipslout,*) c_nam//" 2.0"
 !-
   i_s = 1;
@@ -702 +733 @@
 ! 3.0 Latitude
 !-
-  IF (l_dbg) WRITE(*,*) c_nam//" 3.0"
+  IF (l_dbg) WRITE(ipslout,*) c_nam//" 3.0"
 !-
   i_e = 2;
@@ -736 +767 @@
 ! 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 +864 @@
 !    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 +914 @@
 !-
   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 +949 @@
 !-
   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 +1047 @@
 !     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 +1101 @@
 !-
   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 +1195 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "histdef : 3.0"
+    WRITE(ipslout,*) "histdef : 3.0"
   ENDIF
 !-
@@ -1175 +1206 @@
  &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= "never") )THEN
     ALLOCATE(W_F(idf)%W_V(iv)%t_bf(buff_sz))
-    W_F(idf)%W_V(iv)%t_bf(:) = 0.
+    W_F(idf)%W_V(iv)%t_bf(:) = missing_val
     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 +1218 @@
 !     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 +1303 @@
 ! 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 +1329 @@
 ! 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 +1362 @@
   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 +1416 @@
 ! 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 +1504 @@
 ! 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 +1606 @@
 !-
         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 +1627 @@
 ! 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 +1633 @@
 ! 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 +1713 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "histwrite : ",c_nam
+    WRITE(ipslout,*) "histwrite : ",c_nam
   ENDIF
 !-
@@ -1791 +1822 @@
     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 +1829 @@
     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
@@ -1861 +1892 @@
   INTEGER,DIMENSION(4) :: corner,edges
   INTEGER :: itime
+  LOGICAL :: flag
 !-
   REAL :: rtime
@@ -1871 +1903 @@
 !-
   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 +1920 @@
   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 +1938 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "histwrite: 3.0",idf
+    WRITE(ipslout,*) "histwrite: 3.0",idf
   ENDIF
 !-
@@ -1924 +1956 @@
  &      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 +1966 @@
  &      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 +1974 @@
 !-
     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 +2031 @@
 !-
     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 +2048 @@
 !-
     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
 !-
     IF (     (TRIM(tmp_opp) /= "inst") &
  &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
-      CALL moycum(tmp_opp,tsz,W_F(idf)%W_V(iv)%t_bf, &
- &           tbf_2,W_F(idf)%W_V(iv)%nb_opp)
+
+!-
+!------ 5.1 Check if scatter operation is performed
+!-      
+       flag = .FALSE. 
+       DO io = 1, nbopp_max
+          IF ( INDEX(TRIM(W_F(idf)%W_V(iv)%sopp(io)),'scatter') > 0 ) THEN 
+             flag = .TRUE. 
+          END IF
+       END DO
+
+       IF ( flag ) THEN
+!-
+!------ 5.2  Enter moycum_index only if a scatter operation is performed
+!-         
+          IF (l_dbg) &
+               & WRITE(ipslout,*) "histwrite: 5.2 moycum_index",nbindex,nx,ny,nz
+          CALL moycum_index(tmp_opp, W_F(idf)%W_V(iv)%t_bf, &
+ &             tbf_2, W_F(idf)%W_V(iv)%nb_opp, nbindex, nindex)
+       ELSE
+!-
+!------ 5.3  Enter moycum otherwise
+!-
+          IF (l_dbg) &
+               & WRITE(ipslout,*) "histwrite: 5.3 moycum",nbindex,nx,ny
+          CALL moycum(tmp_opp,tsz,W_F(idf)%W_V(iv)%t_bf, &
+               &           tbf_2,W_F(idf)%W_V(iv)%nb_opp)
+       END IF
+
     ENDIF
 !-
@@ -2032 +2091 @@
 ! 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 +2100 @@
 !-- 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 +2114 @@
  &      .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 +2136 @@
 !-
     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 +2218 @@
 !-
   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 +2262 @@
  &       '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
@@ -2249 +2308 @@
       ENDIF
       varseq_err(idf) = varseq_err(idf)+1
+      IF (l_dbg) &
+           WRITE(ipslout,*) "Error history file ",W_F(idf)%name," names : ", &
+ &           TRIM(W_F(idf)%W_V(idv)%v_name),TRIM(pvarname)," id : ",idv
     ELSE
 !-
@@ -2268 +2330 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) &
+    WRITE(ipslout,*) &
  &   'histvar_seq, end of the subroutine :',TRIM(pvarname),idv
   ENDIF
@@ -2294 +2356 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->histsync"
+    WRITE(ipslout,*) "->histsync"
   ENDIF
 !-
@@ -2319 +2381 @@
     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 +2388 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-histsync"
+    WRITE(ipslout,*) "<-histsync"
   ENDIF
 !----------------------
@@ -2349 +2411 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "->histclo"
+    WRITE(ipslout,*) "->histclo"
   ENDIF
 !-
@@ -2374 +2436 @@
     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 +2444 @@
 !-----
       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 +2450 @@
         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 +2482 @@
 !---- 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 +2490 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "<-histclo"
+    WRITE(ipslout,*) "<-histclo"
   ENDIF
 !---------------------

dynamico_lmdz/aquaplanet/IOIPSL/src/mathelp.f90

@@ -1 +1 @@
 MODULE mathelp
 !-
-!$Id: mathelp.f90 845 2009-12-10 16:26:03Z bellier $
+!$Id: mathelp.f90 1927 2012-11-22 13:54:21Z dsolyga $
 !-
 ! This software is governed by the CeCILL license
@@ -10 +10 @@
 !-
   PRIVATE
-  PUBLIC :: mathop,moycum,buildop
+  PUBLIC :: mathop,moycum,moycum_index,buildop
 !-
   INTERFACE mathop
@@ -3119 +3119 @@
 END SUBROUTINE moycum
 !===
+SUBROUTINE moycum_index( opp, px, py, pwx, nbi, ind )
+!---------------------------------------------------------------------
+!- Does time operations on index points 
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Parameters and variables declaration
+
+  !! 0.1 Input variables
+
+  CHARACTER(LEN=7), INTENT(in)        :: opp  !! Operation performed
+  INTEGER, INTENT(in)                 :: nbi  !! Size of index vector
+  INTEGER, DIMENSION(nbi), INTENT(in) :: ind  !! Index vector
+  REAL, DIMENSION(:), INTENT(in)      :: py   !! Vector containing the 
+                                              !! previous values of px
+                                              !! Warning : due to memory 
+                                              !! optimization, we have
+                                              !! generally SIZE(px) /= SIZE(py)  
+  INTEGER, INTENT(in)                 :: pwx  !! Used to calculate average value                             
+
+  !! 0.3 Modified variables
+
+  REAL, DIMENSION(:), INTENT(inout)   :: px   !! Result
+
+  !! 0.4 Local variables
+
+  INTEGER :: ig                               !! Index
+
+!---------------------------------------------------------------------
+
+  !! Perform operations only if the values of ind don't exceed the size of px 
+
+  IF ( MAXVAL(ind) > SIZE(px) ) THEN
+     CALL ipslerr(3,"moycum_index", &
+          & "the index vector is out of range for px", &
+          & "Indexation vector problem. We stop", " " )
+  END IF
+
+  IF (pwx /= 0) THEN
+     IF      (opp == 'ave') THEN
+        DO ig = 1,nbi
+           px(ind(ig)) = (px(ind(ig))*pwx + py(ind(ig)))/REAL(pwx+1)
+        END DO
+     ELSE IF (opp == 't_sum') THEN
+        DO ig = 1,nbi
+           px(ind(ig)) = px(ind(ig)) + py(ind(ig))
+        END DO
+     ELSE IF ( (opp == 'l_min').OR.(opp == 't_min') ) THEN
+        DO ig = 1,nbi
+           px(ind(ig)) = MIN(px(ind(ig)),py(ind(ig)))
+        END DO
+     ELSE IF ( (opp == 'l_max').OR.(opp == 't_max') ) THEN
+        DO ig = 1,nbi
+           px(ind(ig)) = MAX(px(ind(ig)),py(ind(ig)))
+        END DO
+     ELSE
+        CALL ipslerr(3,"moycum_index",'Unknown time operation',opp,' ')
+     END IF
+  ELSE
+    IF      (opp == 'l_min') THEN
+       DO ig = 1,nbi
+          px(ind(ig)) = MIN(px(ind(ig)),py(ind(ig)))
+       END DO
+    ELSE IF (opp == 'l_max') THEN
+       DO ig = 1,nbi
+          px(ind(ig)) = MAX(px(ind(ig)),py(ind(ig)))
+       END DO
+    ELSE
+       DO ig = 1,nbi
+          px(ind(ig)) = py(ind(ig))
+       END DO
+    ENDIF
+ END IF
+
+END SUBROUTINE moycum_index
+
+
 !-----------------
 END MODULE mathelp

dynamico_lmdz/aquaplanet/IOIPSL/src/restcom.f90

@@ -1 +1 @@
 MODULE restcom
 !-
-!$Id: restcom.f90 430 2008-10-23 14:33:11Z bellier $
+!$Id: restcom.f90 2020 2013-03-07 09:22:15Z jgipsl $
 !-
 ! This software is governed by the CeCILL license
@@ -8 +8 @@
 USE netcdf
 !-
-USE errioipsl, ONLY : ipslerr,ipsldbg
+USE errioipsl, ONLY : ipslerr,ipsldbg, ipslout
 USE stringop
 USE calendar
@@ -49 +49 @@
   INTEGER,SAVE :: nb_fi = 0
   INTEGER,DIMENSION(max_file,2),SAVE :: netcdf_id = -1
+  CHARACTER(LEN=120),DIMENSION(max_file,2),SAVE :: netcdf_name='NONE'
 !-
 ! Description of the content of the 'in' files and the 'out' files.
@@ -230 +231 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) 'restini 0.0 : ',TRIM(fnamein),' , ',TRIM(fnameout)
+    WRITE(ipslout,*) 'restini 0.0 : ',TRIM(fnamein),' , ',TRIM(fnameout)
   ENDIF
 !-
@@ -254 +255 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) 'restini 0.1 l_fi, l_fo, l_rw : ',l_fi,l_fo,l_rw
+    WRITE(ipslout,*) 'restini 0.1 l_fi, l_fo, l_rw : ',l_fi,l_fo,l_rw
   ENDIF
 !-
@@ -261 +262 @@
   IF (l_fi) THEN
 !---
-    IF (l_dbg) WRITE(*,*) 'restini 1.0 : Open input file'
+    IF (l_dbg) WRITE(ipslout,*) 'restini 1.0 : Open input file'
 !-- Add DOMAIN number and ".nc" suffix in file names if needed
     fname = fnamein
@@ -268 +269 @@
     CALL restopenin (nb_fi,fname,l_rw,iim,jjm,lon,lat,llm,lev,ncfid)
     netcdf_id(nb_fi,1) = ncfid
+    netcdf_name(nb_fi,1) = TRIM(fnamein)
 !---
 !-- 1.3 Extract the time information
@@ -284 +286 @@
 !-- 2.0 The case of a missing restart file is dealt with
 !---
-    IF (l_dbg) WRITE(*,*) 'restini 2.0'
+    IF (l_dbg) WRITE(ipslout,*) 'restini 2.0'
 !---
     IF (     (ALL(MINLOC(lon(:iim,:jjm)) == MAXLOC(lon(:iim,:jjm)))) &
@@ -324 +326 @@
       (nb_fi,fname,iim,jjm,lon,lat,llm,lev,dt,date0,ncfid,domain_id)
     netcdf_id(nb_fi,2) = ncfid
+    netcdf_name(nb_fi,2) = TRIM(fnameout)
   ELSE IF (l_fi.AND.l_fo) THEN
     netcdf_id(nb_fi,2) = netcdf_id(nb_fi,1)
+    netcdf_name(nb_fi,2) = netcdf_name(nb_fi,1)
     varname_out(nb_fi,:) = varname_in(nb_fi,:)
     nbvar_out(nb_fi) = nbvar_in(nb_fi)
@@ -340 +344 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) 'restini 2.3 : Configure calendar if needed : ', &
+    WRITE(ipslout,*) 'restini 2.3 : Configure calendar if needed : ', &
                 calend_str
   ENDIF
@@ -347 +351 @@
     CALL ioconf_calendar (calend_str)
     IF (l_dbg) THEN
-      WRITE(*,*) 'restini 2.3b : new calendar : ',calend_str
+      WRITE(ipslout,*) 'restini 2.3b : new calendar : ',calend_str
     ENDIF
   ENDIF
@@ -359 +363 @@
   fid = nb_fi
   IF (l_dbg) THEN
-    WRITE(*,*) 'SIZE of t_index :',SIZE(t_index), &
+    WRITE(ipslout,*) 'SIZE of t_index :',SIZE(t_index), &
                SIZE(t_index,dim=1),SIZE(t_index,dim=2)
-    WRITE(*,*) 't_index = ',t_index(fid,:)
+    WRITE(ipslout,*) 't_index = ',t_index(fid,:)
   ENDIF
   itau = t_index(fid,1)
 !-
-  IF (l_dbg) WRITE(*,*) 'restini END'
+  IF (l_dbg) WRITE(ipslout,*) 'restini END'
 !---------------------
 END SUBROUTINE restini
@@ -502 +506 @@
 ! 2.0 Get the list of variables
 !-
-  IF (l_dbg) WRITE(*,*) 'restopenin 1.2'
+  IF (l_dbg) WRITE(ipslout,*) 'restopenin 1.2'
 !-
   lat_vid = -1
@@ -663 +667 @@
       CALL ioconf_calendar (calendar)
       IF (l_dbg) THEN
-        WRITE(*,*) 'restsett : calendar of the restart ',calendar
+        WRITE(ipslout,*) 'restsett : calendar of the restart ',calendar
       ENDIF
     ENDIF
@@ -669 +673 @@
   CALL ioget_calendar (one_year,one_day)
   IF (l_dbg) THEN
-    WRITE(*,*) 'one_year,one_day = ',one_year,one_day
+    WRITE(ipslout,*) 'one_year,one_day = ',one_year,one_day
   ENDIF
 !-
@@ -681 +685 @@
       t_index(nb_fi,:) = itau
       IF (l_dbg) THEN
-        WRITE(*,*) "nb_fi,t_index",nb_fi,t_index(nb_fi,:)
+        WRITE(ipslout,*) "nb_fi,t_index",nb_fi,t_index(nb_fi,:)
       ENDIF
       CALL ju2ymds (date0,year0,month0,day0,sec0)
@@ -691 +695 @@
       strc=':'
       IF (l_dbg) THEN
-        WRITE(*,*) date0
+        WRITE(ipslout,*) date0
         WRITE (UNIT=itau_orig,FMT='(I4.4,5(A,I2.2))') &
  &       year0,'-',month0,'-',day0,' ',hours0,':',minutes0,':',seci
-        WRITE(*,*) "itau_orig : ",itau_orig
+        WRITE(ipslout,*) "itau_orig : ",itau_orig
       ENDIF
     ELSE
       iret = NF90_GET_VAR(ncfid,tind_varid_in(nb_fi),t_index(nb_fi,:))
       IF (l_dbg) THEN
-        WRITE(*,*) "restsett, time axis : ",t_index(nb_fi,:)
+        WRITE(ipslout,*) "restsett, time axis : ",t_index(nb_fi,:)
       ENDIF
       iret = NF90_GET_ATT(ncfid,tind_varid_in(nb_fi),'units',itau_orig)
@@ -727 +731 @@
     iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'calendar',tmp_cal)
     IF (l_dbg) THEN
-      WRITE(*,*) 'restsett : tmp_calendar of the restart ',tmp_cal
+      WRITE(ipslout,*) 'restsett : tmp_calendar of the restart ',tmp_cal
     ENDIF
 !---
@@ -744 +748 @@
 !-- to get ride of the intial date.
 !---
-    IF (l_dbg) WRITE(*,*) 'tax_orig : ',TRIM(tax_orig)
+    IF (l_dbg) WRITE(ipslout,*) 'tax_orig : ',TRIM(tax_orig)
     READ (UNIT=tax_orig,FMT='(I4.4,5(a,I2.2))') &
       year0,strc,month0,strc,day0,strc, &
@@ -831 +835 @@
   CALL ipsldbg (old_status=l_dbg)
 !-
-  IF (l_dbg) WRITE(*,*) "restopenout 0.0 ",TRIM(fname)
+  IF (l_dbg) WRITE(ipslout,*) "restopenout 0.0 ",TRIM(fname)
 !-
 !  If we use the same file for input and output
 !- we will not even call restopenout
 !-
-  iret = NF90_CREATE(fname,NF90_NOCLOBBER,ncfid)
+  iret = NF90_CREATE(fname,cmode=or(NF90_NOCLOBBER,NF90_64BIT_OFFSET),ncid=ncfid)
   IF (iret == -35) THEN
     CALL ipslerr (3,'restopenout',&
@@ -863 +867 @@
 ! 1.0 Longitude
 !-
-  IF (l_dbg) WRITE(*,*) "restopenout 1.0"
+  IF (l_dbg) WRITE(ipslout,*) "restopenout 1.0"
 !-
   iret = NF90_DEF_VAR(ncfid,"nav_lon",NF90_FLOAT,(/x_id,y_id/),nlonid)
@@ -873 +877 @@
 ! 2.0 Latitude
 !-
-  IF (l_dbg) WRITE(*,*) "restopenout 2.0"
+  IF (l_dbg) WRITE(ipslout,*) "restopenout 2.0"
 !-
   iret = NF90_DEF_VAR(ncfid,"nav_lat",NF90_FLOAT,(/x_id,y_id/),nlatid)
@@ -883 +887 @@
 ! 3.0 Levels
 !-
-  IF (l_dbg) WRITE(*,*) "restopenout 3.0"
+  IF (l_dbg) WRITE(ipslout,*) "restopenout 3.0"
 !-
   iret = NF90_DEF_VAR(ncfid,"nav_lev",NF90_FLOAT,z_id,nlevid)
@@ -895 +899 @@
 ! 4.0 Time axis, this is the seconds since axis
 !-
-  IF (l_dbg) WRITE(*,*) "restopenout 4.0"
+  IF (l_dbg) WRITE(ipslout,*) "restopenout 4.0"
 !-
   iret = NF90_DEF_VAR(ncfid,"time",NF90_FLOAT, &
@@ -923 +927 @@
 ! 5.0 Time axis, this is the time steps since axis
 !-
-  IF (l_dbg) WRITE(*,*) "restopenout 5.0"
+  IF (l_dbg) WRITE(ipslout,*) "restopenout 5.0"
 !-
   iret = NF90_DEF_VAR(ncfid,"time_steps",NF90_INT, &
@@ -984 +988 @@
   iret = NF90_REDEF(ncfid)
 !-
-  IF (l_dbg) WRITE(*,*) "restopenout END"
+  IF (l_dbg) WRITE(ipslout,*) "restopenout END"
 !-------------------------
 END SUBROUTINE restopenout
@@ -1372 +1376 @@
   CHARACTER(LEN=80) attname
   INTEGER,DIMENSION(4) :: corner,edge
-!---------------------------------------------------------------------
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!---------------------------------------------------------------------
+  IF (l_dbg) WRITE(ipslout,*) 'RESTGET 0.0 : ',netcdf_name(fid,2),vname_q,iim,jjm,llm,itau,def_beha
+!-
   ncfid = netcdf_id(fid,1)
 !-
@@ -1379 +1388 @@
 ! 1.0 If the variable is not present then ERROR or filled up
 !     by default values if allowed
+!-
+  IF (l_dbg) WRITE(ipslout,*) 'RESTGET 1.0 : ',vnb
 !-
   IF (vnb < 0) THEN
@@ -1402 +1413 @@
 !-----
       CALL restdefv (fid,vname_q,iim,jjm,llm,.TRUE.)
+      IF (l_dbg) WRITE(ipslout,*) 'RESTGET 1.1 : ',vnb
 !-----
     ELSE
@@ -1416 +1428 @@
 !---
     vid = varid_in(fid,vnb)
+    IF (l_dbg) WRITE(ipslout,*) 'RESTGET 2.0 : ',vid
 !---
     nbvar_read(fid) = nbvar_read(fid)+1
@@ -1437 +1450 @@
  &      str,'is not available in the current file',' ')
     ENDIF
+    IF (l_dbg) WRITE(ipslout,*) 'RESTGET 3.0 : ',index
 !---
 !-- 4.0 Read the data. Note that the variables in the restart files
@@ -1488 +1502 @@
     iret = NF90_GET_VAR(ncfid,vid,var, &
  &                      start=corner(1:ndim),count=edge(1:ndim))
+    IF (l_dbg) WRITE(ipslout,*) 'RESTGET 4.0 : ',iret
 !---
 !-- 5.0 The variable we have just read is created
@@ -1900 +1915 @@
   CALL ioget_calendar (one_year,one_day)
 !-
+! 0.0 show arguments
+  IF (l_dbg) WRITE(ipslout,*) 'RESTPUT 0.0 : ',netcdf_name(fid,2),vname_q,iim,jjm,llm,itau
+!-
 ! 1.0 Check if the variable is already present
 !-
-  IF (l_dbg) WRITE(*,*) 'RESTPUT 1.0 : ',TRIM(vname_q)
+  IF (l_dbg) WRITE(ipslout,*) 'RESTPUT 1.0 : ',TRIM(vname_q)
 !-
   CALL find_str (varname_out(fid,1:nbvar_out(fid)),vname_q,vnb)
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) 'RESTPUT 1.1 : ',varname_out(fid,1:nbvar_out(fid)),vnb
+    WRITE(ipslout,*) 'RESTPUT 1.1 : ',varname_out(fid,1:nbvar_out(fid)),vnb
   ENDIF
 !-
@@ -1919 +1937 @@
   vid = varid_out(fid,vnb)
 !-
-  IF (l_dbg) WRITE(*,*) 'RESTPUT 2.0 : ',vnb,vid
+  IF (l_dbg) WRITE(ipslout,*) 'RESTPUT 2.0 : ',vnb,vid
 !-
 ! 2.1 Is this file already in write mode ?
@@ -1932 +1950 @@
 !     If not then check that all variables of previous time is OK.
 !-
-  IF (l_dbg) WRITE(*,*) 'RESTPUT 3.0 : ',itau,itau_out(fid)
+  IF (l_dbg) WRITE(ipslout,*) 'RESTPUT 3.0 : ',itau,itau_out(fid)
 !-
   IF (itau /= itau_out(fid)) THEN
@@ -1942 +1960 @@
     IF (tstp_out(fid) == 0) THEN
       IF (nbvar_out(fid) < nbvar_read(fid)) THEN
-        WRITE(*,*) "ERROR :",tstp_out(fid), &
+        WRITE(ipslout,*) "ERROR :",tstp_out(fid), &
                    nbvar_out(fid),nbvar_read(fid)
         CALL ipslerr (1,'restput', &
@@ -1955 +1973 @@
       ENDDO
       IF (ierr > 0) THEN
-        WRITE(*,*) "ERROR :",nbvar_out(fid)
+        WRITE(ipslout,*) "ERROR :",nbvar_out(fid)
         CALL ipslerr (1,'restput', &
  &        'There are fewer variables in the output file for this', &
@@ -1971 +1989 @@
 !---
     IF (l_dbg) THEN
-      WRITE(*,*) 'RESTPUT 3.1 : ',itau,secsince,corner(1),edge(1)
+      WRITE(ipslout,*) 'RESTPUT 3.1 : ',itau,secsince,corner(1),edge(1)
     ENDIF
 !---
@@ -2053 +2071 @@
   IF (itau_out(fid) >= 0) THEN
     iret = NF90_REDEF(ncfid)
+    IF (l_dbg) THEN
+       WRITE(ipslout,*) 'restdefv 0.0 : REDEF',itau_out(fid)
+    ENDIF
   ENDIF
 !-
@@ -2058 +2079 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) 'restdefv 1.0 :',TRIM(varname),nbvar_out(fid)
+    WRITE(ipslout,*) 'restdefv 1.0 :',TRIM(varname),nbvar_out(fid)
   ENDIF
 !-
@@ -2134 +2155 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) 'restdefv 2.0 :',ndim,' :: ',dims(1:ndim),tdimid_out(fid)
+    WRITE(ipslout,*) 'restdefv 2.0 :',ndim,' :: ',dims(1:ndim),tdimid_out(fid)
   ENDIF
 !-
@@ -2169 +2190 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) &
+    WRITE(ipslout,*) &
  &    'restdefv 3.0 : LIST OF VARS ',varname_out(fid,1:nbvar_out(fid))
   ENDIF
@@ -2193 +2214 @@
   IF (.NOT.ALLOCATED(t_index) .AND. .NOT.ALLOCATED(t_julian)) THEN
     IF (l_msg) THEN
-      WRITE(*,*) TRIM(c_p)//' : Allocate times axes at :', &
+      WRITE(ipslout,*) TRIM(c_p)//' : Allocate times axes at :', &
  &               max_file,tax_size_in(nb_fi)
     ENDIF
@@ -2199 +2220 @@
     ALLOCATE(t_index(max_file,tax_size_in(nb_fi)),STAT=i_err)
     IF (i_err/=0) THEN
-      WRITE(*,*) "ERROR IN ALLOCATION of t_index : ",i_err
+      WRITE(ipslout,*) "ERROR IN ALLOCATION of t_index : ",i_err
       CALL ipslerr (3,TRIM(c_p), &
  &      'Problem in allocation of t_index','', &
@@ -2208 +2229 @@
     ALLOCATE(t_julian(max_file,tax_size_in(nb_fi)),STAT=i_err)
     IF (i_err/=0) THEN
-      WRITE(*,*) "ERROR IN ALLOCATION of t_julian : ",i_err
+      WRITE(ipslout,*) "ERROR IN ALLOCATION of t_julian : ",i_err
       CALL ipslerr (3,TRIM(c_p), &
  &      'Problem in allocation of max_file,tax_size_in','', &
@@ -2217 +2238 @@
  &         .OR.(SIZE(t_julian,DIM=2) < tax_size_in(nb_fi)) ) THEN
     IF (l_msg) THEN
-      WRITE(*,*) TRIM(c_p)//' : Reallocate times axes at :', &
+      WRITE(ipslout,*) TRIM(c_p)//' : Reallocate times axes at :', &
  &               max_file,tax_size_in(nb_fi)
     ENDIF
@@ -2223 +2244 @@
     ALLOCATE (tmp_index(max_file,tax_size_in(nb_fi)),STAT=i_err)
     IF (i_err/=0) THEN
-      WRITE(*,*) "ERROR IN ALLOCATION of tmp_index : ",i_err
+      WRITE(ipslout,*) "ERROR IN ALLOCATION of tmp_index : ",i_err
       CALL ipslerr (3,TRIM(c_p), &
  &      'Problem in allocation of tmp_index','', &
@@ -2233 +2254 @@
     ALLOCATE (t_index(max_file,tax_size_in(nb_fi)),STAT=i_err)
     IF (i_err/=0) THEN
-      WRITE(*,*) "ERROR IN ALLOCATION of t_index : ",i_err
+      WRITE(ipslout,*) "ERROR IN ALLOCATION of t_index : ",i_err
       CALL ipslerr (3,TRIM(c_p), &
  &     'Problem in reallocation of t_index','', &
@@ -2242 +2263 @@
     ALLOCATE (tmp_julian(max_file,tax_size_in(nb_fi)),STAT=i_err)
     IF (i_err/=0) THEN
-      WRITE(*,*) "ERROR IN ALLOCATION of tmp_julian : ",i_err
+      WRITE(ipslout,*) "ERROR IN ALLOCATION of tmp_julian : ",i_err
       CALL ipslerr (3,TRIM(c_p), &
  &     'Problem in allocation of tmp_julian','', &
@@ -2252 +2273 @@
     ALLOCATE (t_julian(max_file,tax_size_in(nb_fi)),STAT=i_err)
     IF (i_err/=0) THEN
-      WRITE(*,*) "ERROR IN ALLOCATION of t_julian : ",i_err
+      WRITE(ipslout,*) "ERROR IN ALLOCATION of t_julian : ",i_err
       CALL ipslerr (3,TRIM(c_p), &
  &      'Problem in reallocation of t_julian','', &
@@ -2308 +2329 @@
       IF (    (l_alloc1.AND.ALLOCATED(buff_tmp1)) &
  &        .OR.(l_alloc2.AND.ALLOCATED(buff_tmp2)) ) THEN
-        WRITE(*,*) TRIM(c_p)//" : re_allocate "//TRIM(cbn)//"=",i_qsz
+        WRITE(ipslout,*) TRIM(c_p)//" : re_allocate "//TRIM(cbn)//"=",i_qsz
       ELSE
-        WRITE(*,*) TRIM(c_p)//" : allocate "//TRIM(cbn)//"=",i_qsz
+        WRITE(ipslout,*) TRIM(c_p)//" : allocate "//TRIM(cbn)//"=",i_qsz
       ENDIF
     ENDIF
@@ -2479 +2500 @@
 !---
     IF (l_dbg) THEN
-      WRITE(*,*) &
+      WRITE(ipslout,*) &
         'restclo : Closing specified restart file number :', &
-        fid,netcdf_id(fid,1:2)
+        fid,netcdf_id(fid,1:2),netcdf_name(fid,1:2)
     ENDIF
 !---
@@ -2490 +2511 @@
         WRITE (n_f,'(I3)') netcdf_id(fid,1)
         CALL ipslerr (2,'restclo', &
-          "Error "//n_e//" in closing file : "//n_f,'',' ')
+          "Error "//n_e//" in closing file : "//n_f,netcdf_name(fid,1),' ')
       ENDIF
       IF (netcdf_id(fid,1) == netcdf_id(fid,2)) THEN
         netcdf_id(fid,2) = -1
+        netcdf_name(fid,2) = 'NONE'
       ENDIF
       netcdf_id(fid,1) = -1
+      netcdf_name(fid,1) = 'NONE'
     ENDIF
 !---
@@ -2504 +2527 @@
         WRITE (n_f,'(I3)') netcdf_id(fid,2)
         CALL ipslerr (2,'restclo', &
-          "Error "//n_e//" in closing file : "//n_f,'',' ')
+          "Error "//n_e//" in closing file : "//n_f,netcdf_name(fid,2),' ')
       ENDIF
       netcdf_id(fid,2) = -1
+      netcdf_name(fid,2) = 'NONE'
     ENDIF
 !---
   ELSE
 !---
-    IF (l_dbg) WRITE(*,*) 'restclo : Closing all files'
+    IF (l_dbg) WRITE(ipslout,*) 'restclo : Closing all files'
 !---
     DO ifnc=1,nb_fi
@@ -2520 +2544 @@
           WRITE (n_f,'(I3)') netcdf_id(ifnc,1)
           CALL ipslerr (2,'restclo', &
-            "Error "//n_e//" in closing file : "//n_f,'',' ')
+            "Error "//n_e//" in closing file : "//n_f,netcdf_name(ifnc,1),' ')
+        ENDIF
+        IF (l_dbg) THEN
+           WRITE(ipslout,*) &
+                'restclo : Closing specified restart file number :', &
+                ifnc,netcdf_id(ifnc,1:2),netcdf_name(ifnc,1:2)
         ENDIF
         IF (netcdf_id(ifnc,1) == netcdf_id(ifnc,2)) THEN
           netcdf_id(ifnc,2) = -1
+          netcdf_name(ifnc,2) = 'NONE'
         ENDIF
         netcdf_id(ifnc,1) = -1
+        netcdf_name(ifnc,1) = 'NONE'
       ENDIF
 !-----
@@ -2534 +2565 @@
           WRITE (n_f,'(I3)') netcdf_id(ifnc,2)
           CALL ipslerr (2,'restclo', &
-            "Error "//n_e//" in closing file : "//n_f,'',' ')
+            "Error "//n_e//" in closing file : "//n_f,netcdf_name(ifnc,2),' ')
+        END IF
+        IF (l_dbg) THEN
+           WRITE(ipslout,*) &
+                'restclo : Closing specified restart file number :', &
+                ifnc,netcdf_id(ifnc,1:2),netcdf_name(ifnc,1:2)
         END IF
         netcdf_id(ifnc,2) = -1
+        netcdf_name(ifnc,2) = 'NONE'
       ENDIF
     ENDDO