<p><b>laura@ucar.edu</b> 2011-10-17 11:47:32 -0600 (Mon, 17 Oct 2011)</p><p>commented out calls to subroutine endrun<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics/src/core_physics/physics_wrf/module_ra_cam.F
===================================================================
--- branches/atmos_physics/src/core_physics/physics_wrf/module_ra_cam.F        2011-10-17 17:18:33 UTC (rev 1089)
+++ branches/atmos_physics/src/core_physics/physics_wrf/module_ra_cam.F        2011-10-17 17:47:32 UTC (rev 1090)
@@ -1,6 +1,5 @@
 MODULE module_ra_cam
   use module_ra_cam_support
-  use module_cam_support, only: endrun
 
   implicit none
 ! 
@@ -440,6 +439,8 @@
    endif 
 #endif
 
+
+
 ! update CO2 volume mixing ratio (co2vmr)
   
 ! determine time interpolation factors, check sanity
@@ -792,7 +793,6 @@
 !for the shortwave radiation code.
 
 #if !(defined(non_hydrostatic_core) || defined(hydrostatic_core))
-
 !====================================================================
    SUBROUTINE camradinit(                                           &amp;
                          R_D,R_V,CP,G,STBOLT,EP_2,shalf,pptop,               &amp;
@@ -1155,7 +1155,7 @@
             if (AEROSOLt(i, k, m) &lt; speciesmin(m)) then
                write(6,*) 'AEROSOL_INTERPOLATE: negative mass mixing ratio, exiting'
                write(6,*) 'm, column, pver',m, i, k ,AEROSOLt(i, k, m)
-               call endrun ()
+!              call endrun ()
             end if
          end do
       end do
@@ -6855,7 +6855,7 @@
                npasses = npasses + 1
                if (npasses &gt;= 2 ) then
                   write(6,*)'RADCSWMX: Maximum overlap of column ','failed'
-                  call endrun
+!                 call endrun
                endif
                nmxrgn(i)=1
                pmxrgn(i,1)=1.0e30
@@ -7862,7 +7862,7 @@
       end do
 
       if (kount.gt.ncol) then
-         call endrun ('RADOZN: Bad ozone data: non-monotonicity suspected')
+!        call endrun ('RADOZN: Bad ozone data: non-monotonicity suspected')
       end if
 35    continue
    end do

Modified: branches/atmos_physics/src/core_physics/physics_wrf/module_ra_cam_support.F
===================================================================
--- branches/atmos_physics/src/core_physics/physics_wrf/module_ra_cam_support.F        2011-10-17 17:18:33 UTC (rev 1089)
+++ branches/atmos_physics/src/core_physics/physics_wrf/module_ra_cam_support.F        2011-10-17 17:47:32 UTC (rev 1090)
@@ -1,5 +1,4 @@
 MODULE module_ra_cam_support
-  use module_cam_support, only: endrun
   implicit none
       integer, parameter :: r8 = 8
       real(r8), parameter:: inf = 1.e20 ! CAM sets this differently in infnan.F90
@@ -9,8 +8,10 @@
       integer :: ixcldice
 !     integer :: levsiz    ! size of level dimension on dataset
       integer, parameter :: nbands = 2          ! Number of spectral bands
-      integer, parameter :: naer_all = 12 + 1
-      integer, parameter :: naer = 10 + 1
+!     integer, parameter :: naer_all = 12 + 1
+!     integer, parameter :: naer = 10 + 1
+      integer, parameter :: naer_all = 12
+      integer, parameter :: naer = 10
       integer, parameter :: bnd_nbr_LW=7 
       integer, parameter :: ndstsz = 4    ! number of dust size bins
       integer :: idxSUL
@@ -2020,7 +2021,7 @@
          end do
 
          if (kount.gt.ncol) then
-            call endrun ('VERT_INTERPOLATE: Bad data: non-monotonicity suspected in dependent variable')
+!           call endrun ('VERT_INTERPOLATE: Bad data: non-monotonicity suspected in dependent variable')
          end if
       end if
    end do
@@ -2061,7 +2062,7 @@
                write(6,*)'vert_interpolate: aerosol(k),(k+1)',AEROSOL(i,k,m),AEROSOL(i,k+1,m)
                write(6,*)'vert_interpolate: pint(k+1),(k)',pint(i,k+1),pint(i,k)
                write(6,*)'n,c',n,c
-               call endrun()
+!              call endrun()
             end if
          end do
       end do
@@ -2551,12 +2552,12 @@
    if (cycflag) then
       if ((cday &lt; 1.) .or. (cday &gt; (daysperyear+1.))) then
          write(6,*) 'GETFACTORS:', ' bad cday=',cday
-         call endrun ()
+!        call endrun ()
       end if
    else
       if (cday &lt; 1.) then
          write(6,*) 'GETFACTORS:',  ' bad cday=',cday
-         call endrun ()
+!        call endrun ()
       end if
    end if
 !
@@ -2580,7 +2581,7 @@
 
    if (.not. validfactors (fact1, fact2)) then
       write(6,*) 'GETFACTORS: ', ' bad fact1 and/or fact2=', fact1, fact2
-      call endrun ()
+!     call endrun ()
    end if
 
    return
@@ -2860,7 +2861,7 @@
    lentbl = INT(tmax-tmin+2.000001)
    if (lentbl .gt. plenest) then
       write(6,9000) tmax, tmin, plenest
-      call endrun ('GESTBL')    ! Abnormal termination
+!     call endrun ('GESTBL')    ! Abnormal termination
    end if
 !
 ! Begin building es table.
@@ -3002,7 +3003,7 @@
    end if
    if (tr &gt; 40.0) then
       write(6,900) tr
-      call endrun ('GFFGCH')                ! Abnormal termination
+!     call endrun ('GFFGCH')                ! Abnormal termination
    end if
 !
    if(t &lt; (tmelt - tr) .and. itype == 1) go to 10

</font>
</pre>