freupwm.F File Reference

#include "implicit_f.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	freupwm (ikad, key0, kupwm)

Function/Subroutine Documentation

freupwm()

subroutine freupwm	(	integer, dimension(0:*)	ikad,
		character, dimension(*)	key0,
		integer	kupwm )

Definition at line 37 of file freupwm.F.

C-----------------------------------------------
C   D e s c r i p t i o n
C-----------------------------------------------
C This subroutine is reading /UPWM/SUPG card.
C parameter is CUPM=1.0 by default.
C CARD IS OBSOLETE
C In case of /ALE/SUPG/OFF is used then this
C card has no influence and a warning is output
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE ale_mod
      USE names_and_titles_mod, ONLY: ncharline100
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IKAD(0:*),KUPWM
      CHARACTER KEY0(*)*5
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "units_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER IKEY,ID
      CHARACTER(LEN=NCHARLINE100):: TMPLINE
      CHARACTER KEY2*5, KEY3*5,KEY4*5
C
      ikey=kupwm
      IF(ikad(ikey)/=ikad(ikey+1))THEN              
       READ(iusc1,rec=ikad(ikey),fmt='(A)',err=9990)tmpline
       CALL get_keys_id(tmpline, key2, key3,key4, id)       
       IF(key3(1:3)/='OFF' .AND. key3(1:2)/='ON')THEN
         READ(iusc1,rec=ikad(ikey),fmt='(7X,A4)',err=9990)key2
         CALL wriusc2(ikad(ikey)+1,1,key0(ikey))  
         READ(iusc2,*,err=9990)ale%UPWIND%CUPWM  
       ELSEIF(key3(1:3)=='OFF')THEN
          ! /UPWM/SUPG/OFF (obsolete, replaced by /ALE/SUPG/OFF)
           ale%UPWIND%UPWM          = 0
           ale%UPWIND%UPW_UPDATE    = 0
           ale%UPWIND%I_SUPG_ON_OFF = 2
           RETURN
       ENDIF
 
       IF(ale%UPWIND%CUPWM==0.)ale%UPWIND%CUPWM=1.
       IF(key2(1:3)=='STD') THEN
         ale%UPWIND%UPWM=1
       ELSEIF(key2(1:2)=='TG') THEN
         ale%UPWIND%UPWM=2
       ELSEIF(key2(1:4)=='SUPG')THEN
         ale%UPWIND%I_SUPG_ON_OFF = 1
         ale%UPWIND%UPWM=3
         CALL get_keys_id(tmpline, key2, key3,key4, id)
        IF(ale%UPWIND%I_SUPG_ON_OFF==2)THEN
         CALL ancmsg(msgid=034,anmode=aninfo)
         ale%UPWIND%UPWM=0        
        ENDIF
       ELSE
        GOTO 9990
       ENDIF
      ELSE
       IF(ale%UPWIND%I_SUPG_ON_OFF /= 2)THEN
         ale%UPWIND%UPWM=3
         ale%UPWIND%CUPWM=1.
       ELSE
         ale%UPWIND%UPWM=0
       ENDIF
      ENDIF
C
      RETURN
C
 9990 CONTINUE
      CALL ancmsg(msgid=73,anmode=aninfo,c1=key0(ikey))
      CALL arret(0)