New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
testopp.f90 in branches/DEV_r1879_FCM/NEMOGCM/EXTERNAL/IOIPSL/example – NEMO

source: branches/DEV_r1879_FCM/NEMOGCM/EXTERNAL/IOIPSL/example/testopp.f90 @ 1993

Last change on this file since 1993 was 1993, checked in by smasson, 14 years ago

merging IOIPSL/v2_2_1 into the EXTERNAL deposit

File size: 1.6 KB
Line 
1PROGRAM testopp
2!-
3!$Id: testopp.f90 846 2009-12-10 16:26:58Z bellier $
4!-
5! This software is governed by the CeCILL license
6! See IOIPSL/IOIPSL_License_CeCILL.txt
7!---------------------------------------------------------------------
8!- This program allows to test the syntaxic analyzer.
9!---------------------------------------------------------------------
10   USE mathelp
11!-
12   IMPLICIT NONE
13!-
14   INTEGER,PARAMETER :: nbopp_max=10
15   REAL,PARAMETER :: missing_val=1.e20
16!- Please list here all the operation you wish to test.
17!- Do not forget to change the value of nbtest.
18   INTEGER,PARAMETER :: nbtest=3
19   CHARACTER(LEN=30),DIMENSION(nbtest) :: test_opp = &
20  &  (/ "t_max(gather(x*2))            ", &
21  &     "(inst(sqrt(max(X,0)*2.0)))    ", &
22  &     "(once)                        " /)
23!-
24   CHARACTER(LEN=80) :: opp
25   CHARACTER(LEN=50) :: ex_topps = 'ave, inst, t_min, t_max, once'
26   REAL,DIMENSION(nbopp_max) :: tmp_scal
27   CHARACTER(LEN=7),DIMENSION(nbopp_max) :: tmp_sopp
28   CHARACTER(LEN=7) :: tmp_topp
29   INTEGER :: nbopp,i,io
30!---------------------------------------------------------------------
31   DO io=1,nbtest
32     opp = test_opp(io)
33     WRITE(*,*) '-------------------------'
34     WRITE(*,*) ' '
35     WRITE(*,*) 'String to be analyzed : ',TRIM(opp)
36     CALL buildop (TRIM(opp),ex_topps,tmp_topp,missing_val, &
37 &                 tmp_sopp,tmp_scal,nbopp)
38!-
39     WRITE(*,*) 'Time operation   : ',TRIM(tmp_topp)
40     WRITE(*,*) 'Other operations : ',nbopp
41     DO i=1,nbopp
42       WRITE(*,*) ' ',i,' opp : ',tmp_sopp(i),' scalar : ',tmp_scal(i)
43     ENDDO
44   ENDDO
45!------------------
46END PROGRAM testopp
Note: See TracBrowser for help on using the repository browser.