MODULE errioipsl !- !$Id$ !- ! This software is governed by the CeCILL license ! See IOIPSL/IOIPSL_License_CeCILL.txt !--------------------------------------------------------------------- IMPLICIT NONE !- PRIVATE !- 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. !- !=== CONTAINS !=== SUBROUTINE ipslnlf (new_number,old_number) !!-------------------------------------------------------------------- !! The "ipslnlf" routine allows to know and modify !! the current logical number for the messages. !! !! SUBROUTINE ipslnlf (new_number,old_number) !! !! Optional INPUT argument !! !! (I) new_number : new logical number of the file !! !! Optional OUTPUT argument !! !! (I) old_number : current logical number of the file !!-------------------------------------------------------------------- IMPLICIT NONE !- INTEGER,OPTIONAL,INTENT(IN) :: new_number INTEGER,OPTIONAL,INTENT(OUT) :: old_number !--------------------------------------------------------------------- IF (PRESENT(old_number)) THEN old_number = ipslout ENDIF IF (PRESENT(new_number)) THEN ipslout = new_number ENDIF !--------------------- END SUBROUTINE ipslnlf !=== SUBROUTINE ipslerr (plev,pcname,pstr1,pstr2,pstr3) !--------------------------------------------------------------------- !! The "ipslerr" routine !! allows to handle the messages to the user. !! !! INPUT !! !! plev : Category of message to be reported to the user !! 1 = Note to the user !! 2 = Warning to the user !! 3 = Fatal error !! pcname : Name of subroutine which has called ipslerr !! pstr1 !! pstr2 : Strings containing the explanations to the user !! pstr3 !--------------------------------------------------------------------- IMPLICIT NONE !- INTEGER :: plev CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3 !- CHARACTER(LEN=30),DIMENSION(3) :: pemsg = & & (/ "NOTE TO THE USER FROM ROUTINE ", & & "WARNING FROM ROUTINE ", & & "FATAL ERROR FROM ROUTINE " /) !--------------------------------------------------------------------- IF ( (plev >= 1).AND.(plev <= 3) ) THEN ilv_cur = plev ilv_max = MAX(ilv_max,plev) 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(ipslout,'("Fatal error from IOIPSL. STOP in ipslerr with code")') STOP 1 ENDIF !--------------------- END SUBROUTINE ipslerr !=== SUBROUTINE ipslerr_act (new_mode,old_mode) !!-------------------------------------------------------------------- !! The "ipslerr_act" routine allows to know and modify !! the current "action mode" for the error messages, !! and reinitialize the error level values. !! !! SUBROUTINE ipslerr_act (new_mode,old_mode) !! !! Optional INPUT argument !! !! (I) new_mode : new error action mode !! .TRUE. -> STOP in case of fatal error !! .FALSE. -> CONTINUE in case of fatal error !! !! Optional OUTPUT argument !! !! (I) old_mode : current error action mode !!-------------------------------------------------------------------- IMPLICIT NONE !- LOGICAL,OPTIONAL,INTENT(IN) :: new_mode LOGICAL,OPTIONAL,INTENT(OUT) :: old_mode !--------------------------------------------------------------------- IF (PRESENT(old_mode)) THEN old_mode = lact_mode ENDIF IF (PRESENT(new_mode)) THEN lact_mode = new_mode ENDIF ilv_cur = 0 ilv_max = 0 !------------------------- END SUBROUTINE ipslerr_act !=== SUBROUTINE ipslerr_inq (current_level,maximum_level) !!-------------------------------------------------------------------- !! The "ipslerr_inq" routine allows to know !! the current level of the error messages !! and the maximum level encountered since the !! last call to "ipslerr_act". !! !! SUBROUTINE ipslerr_inq (current_level,maximum_level) !! !! Optional OUTPUT argument !! !! (I) current_level : current error level !! (I) maximum_level : maximum error level !!-------------------------------------------------------------------- IMPLICIT NONE !- INTEGER,OPTIONAL,INTENT(OUT) :: current_level,maximum_level !--------------------------------------------------------------------- IF (PRESENT(current_level)) THEN current_level = ilv_cur ENDIF IF (PRESENT(maximum_level)) THEN maximum_level = ilv_max ENDIF !------------------------- END SUBROUTINE ipslerr_inq !=== SUBROUTINE histerr (plev,pcname,pstr1,pstr2,pstr3) !--------------------------------------------------------------------- !- INPUT !- plev : Category of message to be reported to the user !- 1 = Note to the user !- 2 = Warning to the user !- 3 = Fatal error !- pcname : Name of subroutine which has called histerr !- pstr1 !- pstr2 : String containing the explanations to the user !- pstr3 !--------------------------------------------------------------------- IMPLICIT NONE !- INTEGER :: plev CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3 !- CHARACTER(LEN=30),DIMENSION(3) :: pemsg = & & (/ "NOTE TO THE USER FROM ROUTINE ", & & "WARNING FROM ROUTINE ", & & "FATAL ERROR FROM ROUTINE " /) !--------------------------------------------------------------------- IF ( (plev >= 1).AND.(plev <= 3) ) THEN WRITE(*,'(" ")') WRITE(*,'(A," ",A)') TRIM(pemsg(plev)),TRIM(pcname) WRITE(*,'(" --> ",A)') pstr1 WRITE(*,'(" --> ",A)') pstr2 WRITE(*,'(" --> ",A)') pstr3 ENDIF IF (plev == 3) THEN WRITE(ipslout,'("Fatal error from IOIPSL. See stdout for more details")') STOP 1 ENDIF !--------------------- END SUBROUTINE histerr !=== SUBROUTINE ipsldbg (new_status,old_status) !!-------------------------------------------------------------------- !! The "ipsldbg" routine !! allows to activate or deactivate the debug, !! and to know the current status of the debug. !! !! SUBROUTINE ipsldbg (new_status,old_status) !! !! Optional INPUT argument !! !! (L) new_status : new status of the debug !! !! Optional OUTPUT argument !! !! (L) old_status : current status of the debug !!-------------------------------------------------------------------- IMPLICIT NONE !- LOGICAL,OPTIONAL,INTENT(IN) :: new_status LOGICAL,OPTIONAL,INTENT(OUT) :: old_status !--------------------------------------------------------------------- IF (PRESENT(old_status)) THEN old_status = ioipsl_debug ENDIF IF (PRESENT(new_status)) THEN ioipsl_debug = new_status ENDIF !--------------------- END SUBROUTINE ipsldbg !=== !------------------- END MODULE errioipsl