Changeset 957 for IOIPSL


Ignore:
Timestamp:
03/24/10 16:34:25 (15 years ago)
Author:
bellier
Message:

histcom : securize histsync and histclo
fliocom : change argument name of fliocrfd for back compatibility

Location:
IOIPSL/trunk/src
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • IOIPSL/trunk/src/fliocom.f90

    r940 r957  
    6262!! which contains the dimensions needed. 
    6363!! 
    64 !! SUBROUTINE fliocrfd (f_n,f_d_n,f_d_l,f_i,id_dom,cmode,c_f_n) 
     64!! SUBROUTINE fliocrfd (f_n,f_d_n,f_d_l,f_i,id_dom,mode,c_f_n) 
    6565!! 
    6666!! INPUT 
    … …  
    8686!!              This argument can be equal to FLIO_DOM_DEFAULT 
    8787!!              (see "flio_dom_defset"). 
    88 !! (C) cmode  : String of (case insensitive) blank-separated words 
     88!! (C) mode   : String of (case insensitive) blank-separated words 
    8989!!              defining the mode used to create the file. 
    9090!!              Supported keywords : REPLACE, 32, 64 
    … …  
    837837!- 
    838838!=== 
    839 SUBROUTINE fliocrfd (f_n,f_d_n,f_d_l,f_i,id_dom,cmode,c_f_n) 
     839SUBROUTINE fliocrfd (f_n,f_d_n,f_d_l,f_i,id_dom,mode,c_f_n) 
    840840!--------------------------------------------------------------------- 
    841841  IMPLICIT NONE 
    … …  
    846846  INTEGER,INTENT(OUT) :: f_i 
    847847  INTEGER,OPTIONAL,INTENT(IN) :: id_dom 
    848   CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: cmode 
     848  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode 
    849849  CHARACTER(LEN=*),OPTIONAL,INTENT(OUT) :: c_f_n 
    850850!- 
    … …  
    897897  i_opt(:)=-1 
    898898!- 
    899   IF (PRESENT(cmode)) THEN 
     899  IF (PRESENT(mode)) THEN 
    900900!--- 
    901     IF (LEN_TRIM(cmode) > l_string) THEN 
     901    IF (LEN_TRIM(mode) > l_string) THEN 
    902902      CALL ipslerr (3,'fliocrfd', & 
    903  &     '"cmode" argument','too long','to be treated') 
    904     ENDIF 
    905     c_string = cmode(:) 
     903 &     '"mode" argument','too long','to be treated') 
     904    ENDIF 
     905    c_string = mode(:) 
    906906    CALL strlowercase (c_string) 
    907907!--- 

  • IOIPSL/trunk/src/histcom.f90

    r953 r957  
    120120TYPE :: T_D_F 
    121121!-NETCDF IDs for file 
    122   INTEGER :: ncfid 
     122  INTEGER :: ncfid=-1 
    123123!-Time variables 
    124124  INTEGER :: itau0=0 
    … …  
    24132413  INTEGER,INTENT(in),OPTIONAL :: file 
    24142414!- 
    2415   INTEGER :: ifile,nfid,iret 
     2415  INTEGER :: ifile,iret,i_s,i_e 
    24162416!- 
    24172417  LOGICAL :: file_exists 
    … …  
    24202420  CALL ipsldbg (old_status=l_dbg) 
    24212421!- 
    2422   IF (l_dbg) WRITE(*,*) 'Entering loop on files : ',nb_files 
    2423 !- 
    2424 ! 1.The loop on files to synchronise 
    2425 !- 
    2426   DO ifile=1,nb_files 
    2427 !- 
    2428     IF (PRESENT(file)) THEN 
    2429       file_exists = (ifile == file) 
     2422  IF (l_dbg) THEN 
     2423    WRITE(*,*) "->histsync" 
     2424  ENDIF 
     2425!- 
     2426  IF (PRESENT(file)) THEN 
     2427    IF ( (file >= 1).AND.(file <= nb_files) ) THEN 
     2428      IF (W_F(ifile)%ncfid > 0) THEN 
     2429        i_s = file 
     2430        i_e = file 
     2431      ELSE 
     2432        i_s = 1 
     2433        i_e = 0 
     2434        CALL ipslerr (2,'histsync', & 
     2435 &       'Unable to synchronise the file :','probably','not opened') 
     2436      ENDIF 
    24302437    ELSE 
    2431       file_exists = .TRUE. 
    2432     ENDIF 
    2433 !- 
    2434     IF (file_exists) THEN 
     2438      CALL ipslerr (3,'histsync','Invalid file identifier',' ',' ') 
     2439    ENDIF 
     2440  ELSE 
     2441    i_s = 1 
     2442    i_e = nb_files 
     2443  ENDIF 
     2444!- 
     2445  DO ifile=i_s,i_e 
     2446    IF (W_F(ifile)%ncfid > 0) THEN 
    24352447      IF (l_dbg) THEN 
    2436         WRITE(*,*) 'Synchronising specified file number :',ifile 
     2448        WRITE(*,*) '  histsync - synchronising file number ',ifile 
    24372449      ENDIF 
    2438       nfid = W_F(ifile)%ncfid 
    2439       iret = NF90_SYNC (nfid) 
    2440     ENDIF 
    2441 !- 
     2450      iret = NF90_SYNC(W_F(ifile)%ncfid) 
     2451    ENDIF 
    24422452  ENDDO 
     2453!- 
     2454  IF (l_dbg) THEN 
     2455    WRITE(*,*) "<-histsync" 
     2456  ENDIF 
    24432457!---------------------- 
    24442458END SUBROUTINE histsync 
    … …  
    24562470  INTEGER,INTENT(in),OPTIONAL :: idf 
    24572471!- 
    2458   INTEGER :: ifile,nfid,nvid,iret,iv 
    2459   INTEGER :: start_loop,end_loop 
    2460   CHARACTER(LEN=70) :: str70 
     2472  INTEGER :: ifile,nfid,nvid,iret,iv,i_s,i_e 
    24612473  LOGICAL :: l_dbg 
    24622474!--------------------------------------------------------------------- 
    24632475  CALL ipsldbg (old_status=l_dbg) 
    24642476!- 
    2465   IF (l_dbg) WRITE(*,*) 'Entering loop on files :',nb_files 
     2477  IF (l_dbg) THEN 
     2478    WRITE(*,*) "->histclo" 
     2479  ENDIF 
    24662480!- 
    24672481  IF (PRESENT(idf)) THEN 
    2468     start_loop = idf 
    2469     end_loop = idf 
    2470   ELSE 
    2471     start_loop = 1 
    2472     end_loop = nb_files 
    2473   ENDIF 
    2474 !- 
    2475   DO ifile=start_loop,end_loop 
    2476     IF (l_dbg) WRITE(*,*) 'Closing specified file number :',ifile 
    2477     nfid = W_F(ifile)%ncfid 
    2478     iret = NF90_REDEF (nfid) 
    2479 !--- 
    2480 !-- 1. Loop on the number of variables to add some final information 
    2481 !--- 
    2482     IF (l_dbg) WRITE(*,*) 'Entering loop on vars : ',W_F(ifile)%n_var 
    2483     DO iv=1,W_F(ifile)%n_var 
    2484 !---- Extrema 
    2485       IF (W_F(ifile)%W_V(iv)%hist_wrt_rng) THEN 
    2486         IF (l_dbg) THEN 
    2487           WRITE(*,*) 'min value for file :',ifile,' var n. :',iv, & 
    2488          &           ' is : ',W_F(ifile)%W_V(iv)%hist_minmax(1) 
    2489           WRITE(*,*) 'max value for file :',ifile,' var n. :',iv, & 
    2490          &           ' is : ',W_F(ifile)%W_V(iv)%hist_minmax(2) 
    2491         ENDIF 
    2492         IF (W_F(ifile)%W_V(iv)%hist_calc_rng) THEN 
    2493 !-------- Put the min and max values on the file 
    2494           nvid = W_F(ifile)%W_V(iv)%ncvid 
    2495           IF (W_F(ifile)%W_V(iv)%v_typ == hist_r8) THEN 
    2496             iret = NF90_PUT_ATT (nfid,nvid,'valid_min', & 
    2497  &                   REAL(W_F(ifile)%W_V(iv)%hist_minmax(1),KIND=8)) 
    2498             iret = NF90_PUT_ATT (nfid,nvid,'valid_max', & 
    2499  &                   REAL(W_F(ifile)%W_V(iv)%hist_minmax(2),KIND=8)) 
    2500           ELSE 
    2501             iret = NF90_PUT_ATT (nfid,nvid,'valid_min', & 
    2502  &                   REAL(W_F(ifile)%W_V(iv)%hist_minmax(1),KIND=4)) 
    2503             iret = NF90_PUT_ATT (nfid,nvid,'valid_max', & 
    2504  &                   REAL(W_F(ifile)%W_V(iv)%hist_minmax(2),KIND=4)) 
     2482    IF ( (idf >= 1).AND.(idf <= nb_files) ) THEN 
     2483      IF (W_F(ifile)%ncfid > 0) THEN 
     2484        i_s = idf 
     2485        i_e = idf 
     2486      ELSE 
     2487        i_s = 1 
     2488        i_e = 0 
     2489        CALL ipslerr (2,'histclo', & 
     2490 &       'Unable to close the file :','probably','not opened') 
     2491      ENDIF 
     2492    ELSE 
     2493      CALL ipslerr (3,'histclo','Invalid file identifier',' ',' ') 
     2494    ENDIF 
     2495  ELSE 
     2496    i_s = 1 
     2497    i_e = nb_files 
     2498  ENDIF 
     2499!- 
     2500  DO ifile=i_s,i_e 
     2501    IF (W_F(ifile)%ncfid > 0) THEN 
     2502      IF (l_dbg) THEN 
     2503        WRITE(*,*) '  histclo - closing specified file number :',ifile 
     2504      ENDIF 
     2505      nfid = W_F(ifile)%ncfid 
     2506      iret = NF90_REDEF(nfid) 
     2507!----- 
     2508!---- 1. Loop on the number of variables to add some final information 
     2509!----- 
     2510      IF (l_dbg) THEN 
     2511        WRITE(*,*) '  Entering loop on vars : ',W_F(ifile)%n_var 
     2512      ENDIF 
     2513      DO iv=1,W_F(ifile)%n_var 
     2514!------ Extrema 
     2515        IF (W_F(ifile)%W_V(iv)%hist_wrt_rng) THEN 
     2516          IF (l_dbg) THEN 
     2517            WRITE(*,*) 'min value for file :',ifile,' var n. :',iv, & 
     2518 &                     ' is : ',W_F(ifile)%W_V(iv)%hist_minmax(1) 
     2519            WRITE(*,*) 'max value for file :',ifile,' var n. :',iv, & 
     2520 &                     ' is : ',W_F(ifile)%W_V(iv)%hist_minmax(2) 
     2521          ENDIF 
     2522          IF (W_F(ifile)%W_V(iv)%hist_calc_rng) THEN 
     2523!---------- Put the min and max values on the file 
     2524            nvid = W_F(ifile)%W_V(iv)%ncvid 
     2525            IF (W_F(ifile)%W_V(iv)%v_typ == hist_r8) THEN 
     2526              iret = NF90_PUT_ATT(nfid,nvid,'valid_min', & 
     2527 &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(1),KIND=8)) 
     2528              iret = NF90_PUT_ATT(nfid,nvid,'valid_max', & 
     2529 &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(2),KIND=8)) 
     2530            ELSE 
     2531              iret = NF90_PUT_ATT(nfid,nvid,'valid_min', & 
     2532 &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(1),KIND=4)) 
     2533              iret = NF90_PUT_ATT(nfid,nvid,'valid_max', & 
     2534 &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(2),KIND=4)) 
     2535            ENDIF 
    25052536          ENDIF 
    25062537        ENDIF 
    2507       ENDIF 
    2508 !---- Time-Buffers 
    2509       IF (ASSOCIATED(W_F(ifile)%W_V(iv)%t_bf)) THEN 
    2510         DEALLOCATE(W_F(ifile)%W_V(iv)%t_bf) 
    2511       ENDIF 
    2512     ENDDO 
    2513 !--- 
    2514 !-- 2. Close the file 
    2515 !--- 
    2516     IF (l_dbg) WRITE(*,*) 'close file :',nfid 
    2517     iret = NF90_CLOSE (nfid) 
    2518     IF (iret /= NF90_NOERR) THEN 
    2519       WRITE(str70,'("This file has been already closed :",I3)') ifile 
    2520       CALL ipslerr (2,'histclo',str70,'','') 
     2538!------ Time-Buffers 
     2539        IF (ASSOCIATED(W_F(ifile)%W_V(iv)%t_bf)) THEN 
     2540          DEALLOCATE(W_F(ifile)%W_V(iv)%t_bf) 
     2541        ENDIF 
     2542      ENDDO 
     2543!----- 
     2544!---- 2. Close the file 
     2545!----- 
     2546      IF (l_dbg) WRITE(*,*) '  close file :',nfid 
     2547      iret = NF90_CLOSE(nfid) 
     2548      W_F(ifile)%ncfid = -1 
    25212549    ENDIF 
    25222550  ENDDO 
     2551!- 
     2552  IF (l_dbg) THEN 
     2553    WRITE(*,*) "<-histclo" 
     2554  ENDIF 
    25232555!--------------------- 
    25242556END SUBROUTINE histclo 
Note: See TracChangeset for help on using the changeset viewer.