Merge pull request #36 from climbfuji/gmtb-gfsphysics-gnu-support

Gmtb gfsphysics gnu support
NCAR · Jan 12, 2018 · 80d5f95 · 80d5f95
2 parents 5bb13ab + ad64d4f
commit 80d5f95
Show file tree

Hide file tree

Showing 6 changed files with 135 additions and 60 deletions.
diff --git a/GFS_layer/GFS_diagnostics.F90 b/GFS_layer/GFS_diagnostics.F90
@@ -416,7 +416,7 @@ subroutine diag_populate (IPD_Diag, Model, Statein, Stateout, Sfcprop, Coupling,
     IPD_Diag(idx)%zhour          = Model%zhour
     IPD_Diag(idx)%fcst_hour      = Model%fhour
     do nb = 1,nblks
-     IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%fluxr(:,18)
+      IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%fluxr(:,18)
     enddo
 
     !--- fluxr19 and fluxr20 are replaced with the surface temperature
@@ -436,7 +436,7 @@ subroutine diag_populate (IPD_Diag, Model, Statein, Stateout, Sfcprop, Coupling,
     IPD_Diag(idx)%zhour          = Model%zhour
     IPD_Diag(idx)%fcst_hour      = Model%fhour
     do nb = 1,nblks
-     IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%fluxr(:,21)
+      IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%fluxr(:,21)
     enddo
 
     idx = idx + 1
@@ -453,7 +453,7 @@ subroutine diag_populate (IPD_Diag, Model, Statein, Stateout, Sfcprop, Coupling,
     IPD_Diag(idx)%zhour          = Model%zhour
     IPD_Diag(idx)%fcst_hour      = Model%fhour
     do nb = 1,nblks
-     IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%fluxr(:,22)
+      IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%fluxr(:,22)
     enddo
 
     idx = idx + 1
@@ -470,8 +470,7 @@ subroutine diag_populate (IPD_Diag, Model, Statein, Stateout, Sfcprop, Coupling,
     IPD_Diag(idx)%zhour          = Model%zhour
     IPD_Diag(idx)%fcst_hour      = Model%fhour
     do nb = 1,nblks
-
-     IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%fluxr(:,23)
+      IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%fluxr(:,23)
     enddo
 
     idx = idx + 1
@@ -488,7 +487,7 @@ subroutine diag_populate (IPD_Diag, Model, Statein, Stateout, Sfcprop, Coupling,
     IPD_Diag(idx)%zhour          = Model%zhour
     IPD_Diag(idx)%fcst_hour      = Model%fhour
     do nb = 1,nblks
-     IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%fluxr(:,24)
+      IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%fluxr(:,24)
     enddo
 
     idx = idx + 1
@@ -505,7 +504,7 @@ subroutine diag_populate (IPD_Diag, Model, Statein, Stateout, Sfcprop, Coupling,
     IPD_Diag(idx)%zhour          = Model%zhour
     IPD_Diag(idx)%fcst_hour      = Model%fhour
     do nb = 1,nblks
-     IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%fluxr(:,25)
+      IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%fluxr(:,25)
     enddo
 
     idx = idx + 1
@@ -522,7 +521,7 @@ subroutine diag_populate (IPD_Diag, Model, Statein, Stateout, Sfcprop, Coupling,
     IPD_Diag(idx)%zhour          = Model%zhour
     IPD_Diag(idx)%fcst_hour      = Model%fhour
     do nb = 1,nblks
-     IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%fluxr(:,26)
+      IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%fluxr(:,26)
     enddo
 
     idx = idx + 1
@@ -539,7 +538,7 @@ subroutine diag_populate (IPD_Diag, Model, Statein, Stateout, Sfcprop, Coupling,
     IPD_Diag(idx)%zhour          = Model%zhour
     IPD_Diag(idx)%fcst_hour      = Model%fhour
     do nb = 1,nblks
-     IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%fluxr(:,27)
+      IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%fluxr(:,27)
     enddo
 
     idx = idx + 1
@@ -845,7 +844,12 @@ subroutine diag_populate (IPD_Diag, Model, Statein, Stateout, Sfcprop, Coupling,
     IPD_Diag(idx)%zhour          = Model%zhour
     IPD_Diag(idx)%fcst_hour      = Model%fhour
     do nb = 1,nblks
-      IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%topfsw(:)%upfxc
+#ifdef __GFORTRAN__
+       Diag(nb)%topfsw_upfxc_gnufix(:) = Diag(nb)%topfsw(:)%upfxc
+       IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%topfsw_upfxc_gnufix
+#else
+       IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%topfsw(:)%upfxc
+#endif
     enddo
 
     !---topfsw%dnfxc
@@ -863,7 +867,12 @@ subroutine diag_populate (IPD_Diag, Model, Statein, Stateout, Sfcprop, Coupling,
     IPD_Diag(idx)%zhour          = Model%zhour
     IPD_Diag(idx)%fcst_hour      = Model%fhour
     do nb = 1,nblks
-      IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%topfsw(:)%dnfxc
+#ifdef __GFORTRAN__
+       Diag(nb)%topfsw_dnfxc_gnufix(:) = Diag(nb)%topfsw(:)%dnfxc
+       IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%topfsw_dnfxc_gnufix
+#else
+       IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%topfsw(:)%dnfxc
+#endif
     enddo
 
     !---topfsw%upfx0
@@ -881,7 +890,12 @@ subroutine diag_populate (IPD_Diag, Model, Statein, Stateout, Sfcprop, Coupling,
     IPD_Diag(idx)%zhour          = Model%zhour
     IPD_Diag(idx)%fcst_hour      = Model%fhour
     do nb = 1,nblks
-      IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%topfsw(:)%upfx0
+#ifdef __GFORTRAN__
+       Diag(nb)%topfsw_upfx0_gnufix(:) = Diag(nb)%topfsw(:)%upfx0
+       IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%topfsw_upfx0_gnufix
+#else
+       IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%topfsw(:)%upfx0
+#endif
     enddo
 
     !---topflw%upfxc
@@ -899,7 +913,12 @@ subroutine diag_populate (IPD_Diag, Model, Statein, Stateout, Sfcprop, Coupling,
     IPD_Diag(idx)%zhour          = Model%zhour
     IPD_Diag(idx)%fcst_hour      = Model%fhour
     do nb = 1,nblks
-      IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%topflw(:)%upfxc
+#ifdef __GFORTRAN__
+       Diag(nb)%topflw_upfxc_gnufix(:) = Diag(nb)%topflw(:)%upfxc
+       IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%topflw_upfxc_gnufix
+#else
+       IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%topflw(:)%upfxc
+#endif
     enddo
 
 !--- clear sky down long wave is missing?
@@ -919,7 +938,12 @@ subroutine diag_populate (IPD_Diag, Model, Statein, Stateout, Sfcprop, Coupling,
     IPD_Diag(idx)%zhour          = Model%zhour
     IPD_Diag(idx)%fcst_hour      = Model%fhour
     do nb = 1,nblks
-      IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%topflw(:)%upfx0
+#ifdef __GFORTRAN__
+       Diag(nb)%topflw_upfx0_gnufix(:) = Diag(nb)%topflw(:)%upfx0
+       IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%topflw_upfx0_gnufix
+#else
+       IPD_Diag(idx)%data(nb)%var2p => Diag(nb)%topflw(:)%upfx0
+#endif
     enddo
 
     !---srunoff
@@ -2293,7 +2317,7 @@ subroutine diag_populate (IPD_Diag, Model, Statein, Stateout, Sfcprop, Coupling,
       IPD_Diag(idx)%zhour          = Model%zhour
       IPD_Diag(idx)%fcst_hour      = Model%fhour
       do nb = 1,nblks
-        IPD_Diag(idx)%data(nb)%var3p => Diag(nb)%dq3dt(:,:,1)
+        IPD_Diag(idx)%data(nb)%var3p => Diag(nb)%dq3dt(:,:,9)
       enddo
 
       !---du3dt

diff --git a/GFS_layer/GFS_typedefs.F90 b/GFS_layer/GFS_typedefs.F90
@@ -716,6 +716,13 @@ module GFS_typedefs
     type (topflw_type),    pointer :: topflw(:)     => null()   !< lw radiation fluxes at top, component:
                                                !       %upfxc    - total sky upward lw flux at toa (w/m**2)
                                                !       %upfx0    - clear sky upward lw flux at toa (w/m**2)
+#ifdef __GFORTRAN__
+    real (kind=kind_phys), pointer :: topfsw_upfxc_gnufix(:) => null()
+    real (kind=kind_phys), pointer :: topfsw_dnfxc_gnufix(:) => null()
+    real (kind=kind_phys), pointer :: topfsw_upfx0_gnufix(:) => null()
+    real (kind=kind_phys), pointer :: topflw_upfxc_gnufix(:) => null()
+    real (kind=kind_phys), pointer :: topflw_upfx0_gnufix(:) => null()
+#endif
 
     ! Input/output - used by physics
     real (kind=kind_phys), pointer :: srunoff(:)    => null()   !< surface water runoff (from lsm)
@@ -796,9 +803,9 @@ module GFS_typedefs
     real (kind=kind_phys), pointer :: cldcov (:,:)   => null()  !< instantaneous 3D cloud fraction
 
     contains
-      procedure create    => diag_create
-      procedure rad_zero  => diag_rad_zero
-      procedure phys_zero => diag_phys_zero
+      procedure :: create    => diag_create
+      procedure :: rad_zero  => diag_rad_zero
+      procedure :: phys_zero => diag_phys_zero
   end type GFS_diag_type
 
 !----------------
@@ -1233,6 +1240,12 @@ subroutine coupling_create (Coupling, IM, Model)
       Coupling%dwn_mfi  = clear_val
       Coupling%det_mfi  = clear_val
       Coupling%cldcovi  = clear_val
+
+    elseif (.not.Model%uni_cld) then
+
+      allocate (Coupling%cldcovi (IM,Model%levs))
+      Coupling%cldcovi  = clear_val
+
     endif
 
   end subroutine coupling_create
@@ -1503,7 +1516,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
       write(6,*) 'GFS_namelist_read:: namelist file: ',trim(fn_nml),' does not exist'
       stop
     else
-      open (unit=nlunit, file=fn_nml, READONLY, status='OLD', iostat=ios)
+      open (unit=nlunit, file=fn_nml, action='READ', status='OLD', iostat=ios)
     endif
     rewind(nlunit)
     read (nlunit, nml=gfs_physics_nml)
@@ -2340,6 +2353,14 @@ subroutine diag_create (Diag, IM, Model)
     allocate (Diag%fluxr   (IM,Model%nfxr))
     allocate (Diag%topfsw  (IM))
     allocate (Diag%topflw  (IM))
+#ifdef __GFORTRAN__
+    allocate (Diag%topfsw_upfxc_gnufix (IM))
+    allocate (Diag%topfsw_dnfxc_gnufix (IM))
+    allocate (Diag%topfsw_upfx0_gnufix (IM))
+    allocate (Diag%topflw_upfxc_gnufix (IM))
+    allocate (Diag%topflw_upfx0_gnufix (IM))
+#endif
+
     !--- Physics
     !--- In/Out
     allocate (Diag%srunoff (IM))
@@ -2438,7 +2459,13 @@ subroutine diag_rad_zero(Diag, Model)
     if (Model%ldiag3d) then
       Diag%cldcov     = zero
     endif
-
+#ifdef __GFORTRAN__
+    Diag%topfsw_upfxc_gnufix = zero
+    Diag%topfsw_dnfxc_gnufix = zero
+    Diag%topfsw_upfx0_gnufix = zero
+    Diag%topflw_upfxc_gnufix = zero
+    Diag%topflw_upfx0_gnufix = zero
+#endif
 
   end subroutine diag_rad_zero
 

diff --git a/makefile b/makefile
@@ -15,7 +15,11 @@ else
     $(info )
 endif
 
-LIBRARY   = libgfsphys.so
+ifneq (,$(findstring MACOSX,$(CPPDEFS)))
+LIBRARY = libgfsphys.dylib
+else
+LIBRARY = libgfsphys.so
+endif
 VER_MAJOR = 1
 VER_MINOR = 0
 VER_PATCH = 0
@@ -104,7 +108,6 @@ SRCS_f   =  \
 	   ./physics/sfc_nst.f                                                       \
 	   ./physics/sfc_ocean.f                                                     \
 	   ./physics/sfc_sice.f                                                      \
-	   ./physics/sfcsub.f                                                        \
 	   ./physics/sflx.f                                                          \
 	   ./physics/shalcnv.f                                                       \
 	   ./physics/shalcv.f                                                        \
@@ -132,6 +135,7 @@ SRCS_F   = ./physics/aer_cloud.F
 	   ./physics/cldmacro.F                                                      \
 	   ./physics/cldwat2m_micro.F                                                \
 	   ./physics/machine.F                                                       \
+	   ./physics/sfcsub.F                                                        \
 	   ./physics/num_parthds.F                                                   \
 	   ./physics/wv_saturation.F
 
@@ -166,19 +170,27 @@ CAPS = $(CAPS_F90:.F90=.o)
 
 all default: depend $(LIBRARY)
 
+ifneq (,$(findstring MACOSX,$(CPPDEFS)))
+LIBRARY_FULL_NAME = $(subst .dylib,.$(VER_MAJOR).$(VER_MINOR).$(VER_PATCH).dylib,$(LIBRARY))
+$(LIBRARY): $(OBJS) $(CAPS)
+	$(FC) -shared $(OBJS) $(CAPS) $(LDFLAGS) $(NCEPLIBS) -o $(LIBRARY_FULL_NAME)
+	ln -sf $(LIBRARY_FULL_NAME) $(LIBRARY)
+	ln -sf $(LIBRARY_FULL_NAME) $(subst .dylib,.$(VER_MAJOR).dylib,$(LIBRARY))
+else
 $(LIBRARY): $(OBJS) $(CAPS)
 	$(FC) -shared -Wl,-soname,$(LIBRARY).$(VER_MAJOR) $(OBJS) $(CAPS) $(LDFLAGS) $(NCEPLIBS) -o $(LIBRARY).$(VER_MAJOR).$(VER_MINOR).$(VER_PATCH)
 	ln -sf $(LIBRARY).$(VER_MAJOR).$(VER_MINOR).$(VER_PATCH) $(LIBRARY)
 	ln -sf $(LIBRARY).$(VER_MAJOR).$(VER_MINOR).$(VER_PATCH) $(LIBRARY).$(VER_MAJOR)
+endif
 
 # this is the place to override default (implicit) compilation rules
 # and create specific (explicit) rules
 
 ./radiation_aerosols.o : ./gfsphys/radiation_aerosols.f
-	$(FC) $(FFLAGS) $(OTHER_FFLAGS) -xCORE-AVX-I -c $< -o $@
+	$(FC) $(CPPDEFS) $(FFLAGS) $(OTHER_FFLAGS) -xCORE-AVX-I -c $< -o $@
 
 ./GFS_layer/GFS_diagnostics.o : ./GFS_layer/GFS_diagnostics.F90
-	$(FC) $(FFLAGS) $(OTHER_FFLAGS) -O0 -c $< -o $@
+	$(FC) $(CPPDEFS) $(FFLAGS) $(OTHER_FFLAGS) -O0 -c $< -o $@
 
 ifneq (,$(findstring PGIFIX,$(CPPDEFS)))
 $(CAPS):

diff --git a/physics/gcycle.f90 b/physics/gcycle.f90
@@ -133,7 +133,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop)
         write(6,*) 'gcycle:: namelist file: ',trim(Model%fn_nml),' does not exist'
         stop
       else
-        open (unit=Model%nlunit, file=trim(Model%fn_nml), READONLY, status='OLD', iostat=ios)
+        open (unit=Model%nlunit, file=trim(Model%fn_nml), action='READ', status='OLD', iostat=ios)
       endif
       CALL SFCCYCLE (9998, npts, Model%lsoil, SIG1T, Model%fhcyc, &
                      Model%idate(4), Model%idate(2),              &