Changeset 4226 for dynamico_lmdz/simple_physics/phyparam

Timestamp:

Jan 10, 2020, 5:15:21 PM (5 years ago)

Author:

dubos

Message:

simple_physics : ensure F2003 compatibility (PGI Fortran)

Location:

dynamico_lmdz/simple_physics/phyparam

Files:

• Makefile (modified) (2 diffs)
• physics/logging.F90 (modified) (3 diffs)
• physics/read_param_mod.F90 (modified) (3 diffs)
• physics/writefield_mod.F90 (modified) (3 diffs)

dynamico_lmdz/simple_physics/phyparam/Makefile

@@ -1 @@
-# Examples (bash) :
+# known to compile with gfortran version 7, ifort version 17, pgfortran version 18
+# Examples
 # clear ; make clean ; 
-# F90=ifort FFLAGS=-fast time make -j
-# F90=gfortran F90FLAGS=-ffree-line-length-none gmake 
-# known to compile with gfortran version 7, ifort version 17
+# F90=ifort FFLAGS=-fast make
+# F90=gfortran F90FLAGS=-ffree-line-length-none make 
+# F90=pgfortran F90FLAGS="-fast -Minfo=loop" make
 
 # if XCodeML F_Front is installed, set FFRONT=F_Front to parse code into XML
@@ -19 +20 @@
 clean :
         rm -f obj/* include/* lib/* xml/*
+        rmdir obj include lib xml
 
 %.so : $(OBJECTS)
         $(F90) -shared $^ -o $@ 
 
+obj/read_param_mod.o   : logging.o
+obj/write_field_mod.o  : logging.o
 obj/convection.o       : logging.o
 obj/surface.o          : logging.o

dynamico_lmdz/simple_physics/phyparam/physics/logging.F90

@@ -24 +24 @@
   END INTERFACE
 
-#ifdef XCODEML
-  ! XCodeML cannot parse procedure pointers                                                                                                                                             
 
-#define default_flush_plugin flush_plugin
-#define default_log_gridpoint log_gridpoint_plugin
-
-#else
-
-  ! This module provides a default implementation of flush_plugin but the top-level driver is welcome to override it.                                                                    
-  PROCEDURE(plugin), POINTER :: flush_plugin => default_flush_plugin
-
-  ! The top-level driver MUST provide an implementation for log_gridpoint_plugin                                                                                                         
+  ! This module provides a default implementations of plugins but the top-level driver is welcome to override them.  
+  ! Note F2003/F2008: pgfortran (F2003) accepts to initialize pointers only to NULL()
+  ! => plugins are initialzed to NULL() and set to default values in flush_log and log_gridpoint
+#ifndef XCODEML
+  ! Note F2003/F2008: XCodeML cannot parse procedure pointers
+  PROCEDURE(plugin), POINTER :: flush_plugin => NULL()
   PROCEDURE(plugin_log_gridpoint), POINTER :: log_gridpoint_plugin => NULL()
-
 #endif
 
@@ -50 +44 @@
 
   PUBLIC :: logging_buf, logging_bufsize, logging_lineno, flush_log, log_gridpoint, &
-       flush_plugin, log_gridpoint_plugin
+       flush_plugin, log_gridpoint_plugin, default_flush_plugin, &
+       missing_plugin
 
 CONTAINS
+
+  SUBROUTINE missing_plugin(name, mod)
+    CHARACTER(*), INTENT(IN) :: name, mod
+    PRINT *, 'FATAL : plugin ', name, ' not provided by the driver program'
+    PRINT *, '        see ', mod
+    STOP
+  END SUBROUTINE missing_plugin
 
   SUBROUTINE flush_log(lev,tag)
     INTEGER, INTENT(IN) :: lev
     CHARACTER(*), INTENT(IN) :: tag
+#ifndef XCODEML
+    IF(.NOT.ASSOCIATED(flush_plugin)) flush_plugin => default_flush_plugin
     IF(logging_lineno>0 .AND. lev<=max_log_level) CALL flush_plugin(lev, TRIM(tag), logging_buf(1:logging_lineno))
     logging_lineno=0
+#endif
   END SUBROUTINE flush_log
 
@@ -76 +81 @@
     INTEGER, INTENT(IN) :: index
     logging_lineno = logging_lineno+1
+#ifndef XCODEML
+    IF(.NOT.ASSOCIATED(log_gridpoint_plugin)) log_gridpoint_plugin => default_log_gridpoint 
     CALL log_gridpoint_plugin(index, logging_buf(logging_lineno))
+#endif
   END SUBROUTINE log_gridpoint
 

dynamico_lmdz/simple_physics/phyparam/physics/read_param_mod.F90

@@ -1 +1 @@
 MODULE read_param_mod
+  USE logging, ONLY : missing_plugin
   IMPLICIT NONE
   PRIVATE
@@ -31 +32 @@
   END INTERFACE
 
-  PROCEDURE(plugin_read_paramr), POINTER :: read_paramr_plugin => read_paramr_unset
-  PROCEDURE(plugin_read_parami), POINTER :: read_parami_plugin => read_parami_unset
-  PROCEDURE(plugin_read_paramb), POINTER :: read_paramb_plugin => read_paramb_unset
+#ifndef XCODEML
+  ! Note compiler compatibility : see logging.F90
+  PROCEDURE(plugin_read_paramr), POINTER :: read_paramr_plugin => NULL()
+  PROCEDURE(plugin_read_parami), POINTER :: read_parami_plugin => NULL()
+  PROCEDURE(plugin_read_paramb), POINTER :: read_paramb_plugin => NULL()
+#endif
 
   INTERFACE read_param
-     PROCEDURE read_paramr_plugin, read_parami_plugin, read_paramb_plugin
+     PROCEDURE read_paramr, read_parami, read_paramb
   END INTERFACE read_param
 
@@ -43 +47 @@
 CONTAINS
 
-  SUBROUTINE abort_unset(name)
-    CHARACTER(*), INTENT(IN) :: name
-    PRINT *, 'FATAL : plugin ', name, ' not provided by the driver program'
-    PRINT *, '        see read_param_mod'
-    STOP
-  END SUBROUTINE abort_unset
-
-  SUBROUTINE read_paramr_unset(name, defval, val, comment)
+  SUBROUTINE read_paramr(name, defval, val, comment)
     CHARACTER(*), INTENT(IN) :: name, comment
     REAL, INTENT(IN)         :: defval
     REAL, INTENT(OUT)        :: val
-    CALL abort_unset('read_paramr')
-  END SUBROUTINE read_paramr_unset
+#ifndef XCODEML
+    IF(.NOT.ASSOCIATED(read_paramr_plugin)) CALL missing_plugin('read_paramr','read_param_mod')
+    CALL read_paramr_plugin(name, defval, val, comment)
+#endif
+  END SUBROUTINE read_paramr
 
-  SUBROUTINE read_parami_unset(name, defval, val, comment)
+  SUBROUTINE read_parami(name, defval, val, comment)
     CHARACTER(*), INTENT(IN) :: name, comment
     INTEGER, INTENT(IN)      :: defval
     INTEGER, INTENT(OUT)     :: val
-    CALL abort_unset('read_parami')
-  END SUBROUTINE read_parami_unset
+#ifndef XCODEML
+    IF(.NOT.ASSOCIATED(read_parami_plugin)) CALL missing_plugin('read_parami','read_param_mod')
+    CALL read_parami_plugin(name, defval, val, comment)
+#endif
+  END SUBROUTINE read_parami
   
-  SUBROUTINE read_paramb_unset(name, defval, val, comment)
+  SUBROUTINE read_paramb(name, defval, val, comment)
     CHARACTER(*), INTENT(IN) :: name, comment
     LOGICAL, INTENT(IN)      :: defval
     LOGICAL, INTENT(OUT)     :: val
-    CALL abort_unset('read_paramb')
-  END SUBROUTINE read_paramb_unset
+#ifndef XCODEML
+    IF(.NOT.ASSOCIATED(read_paramr_plugin)) CALL missing_plugin('read_paramb','read_param_mod')
+    CALL read_paramb_plugin(name, defval, val, comment)
+#endif
+  END SUBROUTINE read_paramb
   
 END MODULE read_param_mod

dynamico_lmdz/simple_physics/phyparam/physics/writefield_mod.F90

@@ -1 +1 @@
 MODULE writefield_mod
+  USE logging, ONLY : missing_plugin
   IMPLICIT NONE
   PRIVATE
@@ -15 +16 @@
   END INTERFACE
 
-  PROCEDURE(plugin_writefield1), POINTER :: writefield1_plugin => writefield1_unset
-  PROCEDURE(plugin_writefield2), POINTER :: writefield2_plugin => writefield2_unset
-
+#ifndef XCODEML
+  PROCEDURE(plugin_writefield1), POINTER :: writefield1_plugin => NULL()
+  PROCEDURE(plugin_writefield2), POINTER :: writefield2_plugin => NULL()
+#endif
   INTERFACE writefield
-     PROCEDURE writefield1_plugin, writefield2_plugin
+     PROCEDURE writefield1, writefield2
   END INTERFACE writefield
 
@@ -26 +28 @@
 CONTAINS
 
-  SUBROUTINE writefield2_unset(name, longname, unit, var)
+  SUBROUTINE writefield2(name, longname, unit, var)
     CHARACTER(*), INTENT(IN) :: name, longname, unit
     REAL, INTENT(IN)         :: var(:,:)
-    PRINT *, 'FATAL : plugin writefield2 not provided by the driver program'
-    PRINT *, '        see writefield.F90'
-    STOP
-  END SUBROUTINE writefield2_unset
+#ifndef XCODEML
+    IF(ASSOCIATED(writefield2_plugin)) THEN
+       CALL writefield2_plugin(name, longname, unit, var)
+    ELSE
+       CALL missing_plugin('writefield2','writefield_mod')
+    END IF
+#endif
+  END SUBROUTINE writefield2
 
-  SUBROUTINE writefield1_unset(name, longname, unit, var)
+  SUBROUTINE writefield1(name, longname, unit, var)
     CHARACTER(*), INTENT(IN) :: name, longname, unit
     REAL, INTENT(IN)         :: var(:)
-    PRINT *, 'FATAL : plugin writefield1 not provided by the driver program'
-    PRINT *, '        see writefield.F90'
-    STOP
-  END SUBROUTINE writefield1_unset
+#ifndef XCODEML
+    IF(ASSOCIATED(writefield1_plugin)) THEN
+       CALL writefield1_plugin(name, longname, unit, var)
+    ELSE
+       CALL missing_plugin('writefield1','writefield_mod')
+    END IF
+#endif
+  END SUBROUTINE writefield1
   
 END MODULE writefield_mod