Changeset 158 in lmdz_wrf


Ignore:
Timestamp:
Aug 8, 2014, 11:58:19 AM (10 years ago)
Author:
lfita
Message:

Adding threscheck_var3D

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/LMDZ_WRFmeas_develop/WRFV3/lmdz/physiq.F90

    r156 r158  
    13381338      varnamechk = 'ql'
    13391339      CALL check_var3D(fname, varnamechk, qx(:,:,2), klon, klev, largest, .FALSE.)
     1340      varnamechk = 'qv'
     1341      CALL threscheck_var3D(fname, varnamechk, qx(:,:,1), klon, klev, 0.,-1, .FALSE.)
    13401342
    13411343
     
    42214223      varnamechk = 'q_seri'
    42224224      CALL check_var3D(fname, varnamechk, q_seri, klon, klev, largest, .FALSE.)
     4225      varnamechk = 'qv'
     4226      CALL threscheck_var3D(fname, varnamechk, qx(:,:,1), klon, klev, 0.,-1, .FALSE.)
     4227      varnamechk = 'q_seri'
     4228      CALL threscheck_var3D(fname, varnamechk, q_seri, klon, klev, 0, -1, .FALSE.)
     4229      varnamechk = 'pphi'
     4230      CALL threscheck_var3D(fname, varnamechk, pphi, klon, klev, 0., -1, .FALSE.)
    42234231
    42244232      PRINT *,'Lluis Reaching the SORTIES point'
     
    47374745END SUBROUTINE check_var3D
    47384746
     4747SUBROUTINE threscheck_var3D(funcn, varn, var, sizev, zsize, thresvalue, kthres,
     4748  stoprun)
     4749!  Subroutine to check the consistency of a 3D LMDSZ - variable (klon, klev) !
     4750!    * thresvalue: threshold for the variable
     4751
     4752  IMPLICIT NONE
     4753
     4754#include "dimensions.h"
     4755
     4756  INTEGER, INTENT(IN)                                    :: sizev, zsize
     4757  CHARACTER(LEN=50), INTENT(IN)                          :: funcn, varn
     4758  REAL, DIMENSION(sizev,zsize), INTENT(IN)               :: var
     4759  REAL, INTENT(IN)                                       :: thresvalue
     4760  LOGICAL, INTENT(IN)                                    :: stoprun
     4761
     4762! Local
     4763  INTEGER                                                :: i, k, wrongi, xpt, ypt
     4764  CHARACTER(LEN=50)                                      :: errmsg
     4765  LOGICAL                                                :: found
     4766  REAL, DIMENSION(sizev*zsize)                           :: wrongvalues
     4767  INTEGER, DIMENSION(sizev*zsize,2)                      :: wronggridpt
     4768
     4769!!!!!!! Variables
     4770! funcn: at which functino of part of the program variable is checked
     4771! varn: name of the variable
     4772! var: variable to check
     4773! sizev: size of the variable
     4774! zsize: vertical size of the variable
     4775! thresvalue: threshold attenaible value for the variable
     4776! kthres: kind of threshold= -1, below wrong, 1: above wrong
     4777! stoprun: Should the run stop if it founds a problem?
     4778
     4779  errmsg = 'ERROR -- error -- ERROR -- error'
     4780
     4781  found = .FALSE.
     4782  wrongi = 0
     4783  DO i=1,sizev
     4784    DO k=1,zsize
     4785      IF (kthres == -1 .AND. var(i,k) < thresvalue ) THEN
     4786        IF (wrongi == 0) found = .TRUE.
     4787        wrongi = wrongi + 1
     4788        wrongvalues(wrongi) = var(i,k)
     4789        wronggridpt(wrongi,1) = i
     4790        wronggridpt(wrongi,2) = k
     4791      ELSE IF (kthres == 1 .AND. var(i,k) > thresvalue ) THEN
     4792        IF (wrongi == 0) found = .TRUE.
     4793        wrongi = wrongi + 1
     4794        wrongvalues(wrongi) = var(i,k)
     4795        wronggridpt(wrongi,1) = i
     4796        wronggridpt(wrongi,2) = k
     4797      END IF
     4798    END DO
     4799  END DO
     4800
     4801  IF (found) THEN
     4802    PRINT *,TRIM(errmsg)
     4803    PRINT *,"  at '" // TRIM(funcn) // "' variable '" //TRIM(varn)//                 &
     4804      "' is wrong (threshold: ',thresvalue,') in Nvalues= ",wrongi,                  &
     4805      ' at i (x,y) k value___'
     4806    DO i=1,wrongi
     4807       ypt = INT(wronggridpt(i,1)/wiim) + 1
     4808       xpt = wronggridpt(i,1) - (ypt-1)*wiim
     4809      PRINT *,wronggridpt(i,1), '(',xpt,', ',ypt,')', wronggridpt(i,2), wrongvalues(i)
     4810    END DO
     4811    IF (stoprun) THEN
     4812      STOP
     4813    END IF
     4814  END IF
     4815
     4816  RETURN
     4817
     4818END SUBROUTINE threscheck_var3D
     4819
Note: See TracChangeset for help on using the changeset viewer.