Skip to content

Commit

Permalink
HASSLIBS/src/HASS_ENT.F90 -- reduce messages to error.fil
Browse files Browse the repository at this point in the history
  • Loading branch information
@PaulDudaRESPEC
PaulDudaRESPEC committed Jun 3, 2021
1 parent 2bbbdef commit 4014309
Showing 1 changed file with 24 additions and 24 deletions.
48 changes: 24 additions & 24 deletions f90apps/HASSLIBS/src/HASS_ENT.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -94,12 +94,12 @@ INTEGER FUNCTION INQUIRE_NAME(NAME,FUN_DEF)
END IF

WRITE(MSG,*) 'HASS_ENT:INQUIRE_NAME:BEG:',FUN_DEF,FUN_TRY,FUN_OPN,FUN_BASE,' ' // TRIM(NAME)
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)

INQUIRE (FILE=NAME,NUMBER=FUN_OPN,OPENED=OPEN)

WRITE(MSG,*) 'HASS_ENT:INQUIRE_NAME:INX:',FUN_DEF,FUN_TRY,FUN_OPN,OPEN
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)

IF (OPEN .EQV. .FALSE.) THEN !unit not open
IF (FUN_DEF .GE. 0) THEN !don't use old information from file unit table
Expand All @@ -111,15 +111,15 @@ INTEGER FUNCTION INQUIRE_NAME(NAME,FUN_DEF)

DO WHILE (FUN_OPN .EQ. 0) !assign first available unit number to the file
WRITE(MSG,*) 'HASS_ENT:INQUIRE_NAME:INF:',FUN_DEF,FUN_TRY,FUN_OPN,OPEN
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)

IF (OPEN) THEN !open, try the next one
WRITE(MSG,*) 'HASS_ENT:INQUIRE_NAME:INQ:',FUN_DEF,FUN_TRY,FUN_OPN,OPEN
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)
FUN_TRY = FUN_TRY+ 1
ELSE !this will be it
WRITE(MSG,*) 'HASS_ENT:INQUIRE_NAME:DON:',FUN_DEF,FUN_TRY,FUN_OPN,OPEN
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)
FUN_OPN = FUN_TRY
IF (FUN_DEF .LT. 0) THEN !don't reuse unit number (vb6 code)
FUN_BASE= FUN_BASE+ 1
Expand All @@ -129,7 +129,7 @@ INTEGER FUNCTION INQUIRE_NAME(NAME,FUN_DEF)
END DO

WRITE(MSG,*) 'HASS_ENT:INQUIRE_NAME:ASN:',FUN_DEF,FUN_TRY,FUN_OPN,OPEN
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)

INQUIRE_NAME = FUN_OPN

Expand All @@ -143,7 +143,7 @@ END SUBROUTINE F90_W99OPN

SUBROUTINE F90_W99CLO()
dll_export F90_W99CLO
CALL LOG_MSG('HASS_ENT:F90_W99CLO')
!CALL LOG_MSG('HASS_ENT:F90_W99CLO')
CALL LOG_MSG('CLOSE')
END SUBROUTINE F90_W99CLO

Expand All @@ -159,7 +159,7 @@ FUNCTION F90_WDMOPN(UNIT,NAME)
INQUIRE(UNIT=UNIT,OPENED=OPEN)

WRITE(MSG,*) 'HASS_ENT:F90_WDMOPN:',OPEN,' ',TRIM(NAME)
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)

IF (OPEN) THEN
F90_WDMOPN= 1
Expand All @@ -182,12 +182,12 @@ FUNCTION F90_WDMCLO(UNIT)
CHARACTER*256 :: MSG

WRITE(MSG,*) 'HASS_ENT:F90_WDMCLO:UNIT',UNIT
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)

CLOSE(UNIT=UNIT,ERR=99,IOSTAT=IOS)

WRITE(MSG,*) ' NO PROBLEM'
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)

F90_WDMCLO=0
!mark as unusable
Expand Down Expand Up @@ -220,15 +220,15 @@ FUNCTION F90_WDBOPN(RWFLG,WDNAME) RESULT(WDMSFL)
!read only, assign special number
WDMSFL = INQUIRE_NAME(LNAME,100)
WRITE(MSG,*) 'HASS_ENT:F90_WDBOPN:READONLY'
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)
ELSE
WDMSFL= INQUIRE_NAME(LNAME,0)
END IF

CALL GET_WDM_FUN(WDMSFL)

WRITE(MSG,*) 'HASS_ENT:F90_WDBOPN:RWFLG,WDMSFL:',RWFLG,WDMSFL,' ',TRIM(LNAME)
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)

CALL WDBOPN(WDMSFL,LNAME,RWFLG,RETCOD)

Expand Down Expand Up @@ -269,7 +269,7 @@ SUBROUTINE F90_WDBOPNR(RWFLG,WDNAME,WDMSFL,RETCOD)
!CALL GET_WDM_FUN(WDMSFL)

WRITE(MSG,*) 'HASS_ENT:F90_WDBOPNR:entr:WDMSFL,RWFLG:',WDMSFL,RWFLG,' ',TRIM(LNAME)
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)

!IF (WDMSFL .LT. 0) THEN
! WDMSFL = -WDMSFL
Expand Down Expand Up @@ -298,7 +298,7 @@ SUBROUTINE GET_WDM_FUN(WDMSFL)
INTEGER :: NXTWDM

WRITE(MSG,*) 'HASS_ENT:GET_WDM_FUN:entry:WDMSFL:',WDMSFL
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)

IF (WDMSFL .GE. 100) THEN
NXTWDM = WDMSFL
Expand All @@ -317,7 +317,7 @@ SUBROUTINE GET_WDM_FUN(WDMSFL)
END DO

WRITE(MSG,*) 'HASS_ENT:GET_WDM_FUN:exit :WDMSFL:',WDMSFL
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)

END SUBROUTINE

Expand All @@ -334,28 +334,28 @@ FUNCTION F90_WDFLCL(WDMSFL) RESULT (RETCOD)
LOGICAL :: OPEN

WRITE(MSG,*) 'HASS_ENT:F90_WDFLCL:entry:WDMSFL:',WDMSFL
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)

INQUIRE(UNIT=WDMSFL,OPENED=OPEN,NAME=FNAM)

IF (OPEN) THEN
CALL WDFLCL(WDMSFL,RETCOD)
WRITE(MSG,*) 'HASS_ENT:F90_WDFLCL:close:WDMSFL:RETCOD:', &
WDMSFL,RETCOD
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)

INQUIRE(UNIT=WDMSFL,OPENED=OPEN)
WRITE(MSG,*) "HASS_ENT:F90_WDFLCL:opned:WDMSFL:", &
WDMSFL,OPEN
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)
INQUIRE(FILE=FNAM,NUMBER=FUN,OPENED=OPEN)
WRITE(MSG,*) "HASS_ENT:F90_WDFLCL:final:WDMSFL:", &
FUN,OPEN,' ',TRIM(FNAM)
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)
ELSE
!not open, cant close it
WRITE(MSG,*) 'HASS_ENT:F90_WDFLCL:not open'
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)
RETCOD = -255
END IF
END FUNCTION F90_WDFLCL
Expand All @@ -376,7 +376,7 @@ FUNCTION F90_INQNAM (NAM)
INQUIRE (FILE=LNAM,NUMBER=FUN,OPENED=OPEN)

WRITE(MSG,*) 'HASS_ENT:F90_INQNAM:',FUN,OPEN,' ',TRIM(LNAM)
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)

IF (OPEN) THEN
F90_INQNAM = FUN
Expand Down Expand Up @@ -833,7 +833,7 @@ SUBROUTINE F90_WDIINI

dll_export F90_WDIINI

CALL LOG_MSG('HASS_ENT:F90_WDIINI')
!CALL LOG_MSG('HASS_ENT:F90_WDIINI')
CALL WDIINI

END SUBROUTINE F90_WDIINI
Expand Down Expand Up @@ -2254,11 +2254,11 @@ SUBROUTINE F90_WDDSDL (WDMSFL,DSN, &
CHARACTER*256 :: MSG

WRITE(MSG,*) "HASS_ENT:F90_WDDSDL:ENTRY:",WDMSFL,DSN,RETCOD
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)
CALL WDDSDL (WDMSFL,DSN, &
RETCOD)
WRITE(MSG,*) "HASSENT:F90_WDDSDL:EXIT: ",WDMSFL,DSN,RETCOD
CALL LOG_MSG(MSG)
!CALL LOG_MSG(MSG)

END SUBROUTINE F90_WDDSDL

Expand Down

0 comments on commit 4014309

Please sign in to comment.